home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 37 / IOPROG_37.ISO / SOFT / Multilizer.exe / disk1 / data1.cab / data1 / [Group19]VCL Source Professional / IvGrids.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-01-24  |  143.8 KB  |  5,188 lines
  1. unit IvGrids;
  2.  
  3. {$I IVMULTI.INC}
  4.  
  5. interface
  6.  
  7. {$IFDEF IVBIDI}
  8. uses
  9.   Grids;
  10.  
  11. type
  12.   TIvDrawGrid = class(TDrawGrid)
  13.   end;
  14.  
  15.   TIvStringGrid = class(TStringGrid)
  16.   end;
  17. {$ELSE}
  18.  
  19. {$R-}
  20.  
  21. uses
  22.   Windows, SysUtils, Messages, Classes, Graphics, Menus, Controls, Forms,
  23.   StdCtrls, Mask;
  24.  
  25. const
  26.   IvMaxCustomExtents = MaxListSize;
  27.   IvMaxShortInt = High(ShortInt);
  28.  
  29. type
  30.   EIvInvalidGridOperation = class(Exception);
  31.  
  32.   TIvGetExtentsFunc = function(Index: Longint): Integer of object;
  33.  
  34.   TIvGridAxisType = (gaHorizontal, gaVertical);
  35.  
  36.   TIvGridAxisDrawInfo = record
  37.     AxisType: TIvGridAxisType;
  38.     EffectiveLineWidth: Integer;
  39.     FixedBoundary: Integer;
  40.     GridBoundary: Integer;
  41.     GridExtent: Integer;
  42.     LastFullVisibleCell: Longint;
  43.     FullVisBoundary: Integer;
  44.     FixedCellCount: Integer;
  45.     FirstGridCell: Integer;
  46.     GridCellCount: Integer;
  47.     GetExtent: TIvGetExtentsFunc;
  48.   end;
  49.  
  50.   TIvGridDrawInfo = record
  51.     Horz, Vert: TIvGridAxisDrawInfo;
  52.   end;
  53.  
  54.   TIvGridState = (gsNormal, gsSelecting, gsRowSizing, gsColSizing, gsRowMoving,
  55.     gsColMoving);
  56.  
  57.   { TIvInplaceEdit }
  58.  
  59.   TIvCustomGrid = class;
  60.  
  61.   TIvInplaceEdit = class(TCustomMaskEdit)
  62.   private
  63.     FGrid: TIvCustomGrid;
  64.     FClickTime: Longint;
  65.  
  66.     procedure SetGrid(value: TIvCustomGrid);
  67.  
  68.     procedure InternalMove(const Loc: TRect; Redraw: Boolean);
  69.  
  70.     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  71.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  72.     procedure WMPaste(var Message); message WM_PASTE;
  73.     procedure WMCut(var Message); message WM_CUT;
  74.     procedure WMClear(var Message); message WM_CLEAR;
  75.  
  76.   protected
  77.     procedure CreateParams(var Params: TCreateParams); override;
  78.     procedure DblClick; override;
  79.     function EditCanModify: Boolean; override;
  80.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  81.     procedure KeyPress(var Key: Char); override;
  82.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  83.     procedure BoundsChanged; virtual;
  84.     procedure UpdateContents; virtual;
  85.     procedure WndProc(var Message: TMessage); override;
  86.  
  87.     property Grid: TIvCustomGrid read FGrid;
  88.  
  89.   public
  90.     constructor Create(AOwner: TComponent); override;
  91.  
  92.     procedure Deselect;
  93.     procedure Hide;
  94.     procedure Invalidate; override;
  95.     procedure Move(const Loc: TRect);
  96.     function PosEqual(const Rect: TRect): Boolean;
  97.     procedure SetFocus; override;
  98.     procedure UpdateLoc(const Loc: TRect);
  99.     procedure UpdateBidi(value: Boolean);
  100.     function Visible: Boolean;
  101.   end;
  102.  
  103.   { TIvCustomGrid }
  104.  
  105.   TIvGridOption = (goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  106.     goRangeSelect, goDrawFocusSelected, goRowSizing, goColSizing, goRowMoving,
  107.     goColMoving, goEditing, goTabs, goRowSelect,
  108.     goAlwaysShowEditor, goThumbTracking);
  109.   TIvGridOptions = set of TIvGridOption;
  110.   TIvGridDrawState = set of (gdSelected, gdFocused, gdFixed);
  111.   TIvGridScrollDirection = set of (sdLeft, sdRight, sdUp, sdDown);
  112.  
  113.   TIvGridCoord = record
  114.     X: Longint;
  115.     Y: Longint;
  116.   end;
  117.  
  118.   TIvGridRect = record
  119.     case Integer of
  120.       0: (Left, Top, Right, Bottom: Longint);
  121.       1: (TopLeft, BottomRight: TIvGridCoord);
  122.   end;
  123.  
  124.   TIvSelectCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  125.     var CanSelect: Boolean) of object;
  126.   TIvDrawCellEvent = procedure (Sender: TObject; Col, Row: Longint;
  127.     Rect: TRect; State: TIvGridDrawState) of object;
  128.  
  129.   TIvCustomGrid = class(TCustomControl)
  130.   private
  131.     FAnchor: TIvGridCoord;
  132.     FBorderStyle: TBorderStyle;
  133.     FCanEditModify: Boolean;
  134.     FColCount: Longint;
  135.     FColWidths: Pointer;
  136.     FTabStops: Pointer;
  137.     FCurrent: TIvGridCoord;
  138.     FDefaultColWidth: Integer;
  139.     FDefaultRowHeight: Integer;
  140.     FFixedCols: Integer;
  141.     FFixedRows: Integer;
  142.     FFixedColor: TColor;
  143.     FGridLineWidth: Integer;
  144.     FOptions: TIvGridOptions;
  145.     FRowCount: Longint;
  146.     FRowHeights: Pointer;
  147.     FScrollBars: TScrollStyle;
  148.     FTopLeft: TIvGridCoord;
  149.     FSizingIndex: Longint;
  150.     FSizingPos, FSizingOfs: Integer;
  151.     FMoveIndex, FMovePos: Longint;
  152.     FHitTest: TPoint;
  153.     FInplaceEdit: TIvInplaceEdit;
  154.     FInplaceCol, FInplaceRow: Longint;
  155.     FColOffset: Integer;
  156.     FDefaultDrawing: Boolean;
  157.     FEditorMode: Boolean;
  158.     FLocale: Integer;
  159.     FColLocale: TList;
  160.  
  161.     procedure SetLocale(value: Integer);
  162.  
  163.     function GetColLocale(index: Integer): Integer;
  164.     procedure SetColLocale(index: Integer; value: Integer);
  165.  
  166.     function CalcCoordFromPoint(X, Y: Integer;
  167.       const DrawInfo: TIvGridDrawInfo): TIvGridCoord;
  168.     procedure CalcDrawInfo(var DrawInfo: TIvGridDrawInfo);
  169.     procedure CalcDrawInfoXY(var DrawInfo: TIvGridDrawInfo;
  170.       UseWidth, UseHeight: Integer);
  171.     procedure CalcFixedInfo(var DrawInfo: TIvGridDrawInfo);
  172.     function CalcMaxTopLeft(const Coord: TIvGridCoord;
  173.       const DrawInfo: TIvGridDrawInfo): TIvGridCoord;
  174.     procedure CalcSizingState(X, Y: Integer; var State: TIvGridState;
  175.       var Index: Longint; var SizingPos, SizingOfs: Integer;
  176.       var FixedInfo: TIvGridDrawInfo);
  177.     procedure ChangeSize(NewColCount, NewRowCount: Longint);
  178.     procedure ClampInView(const Coord: TIvGridCoord);
  179.     procedure DrawSizingLine(const DrawInfo: TIvGridDrawInfo);
  180.     procedure DrawMove;
  181.     procedure FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  182.     procedure GridRectToScreenRect(
  183.       GridRect: TIvGridRect;
  184.       var ScreenRect: TRect;
  185.       IncludeLine: Boolean);
  186.     procedure HideEdit;
  187.     procedure Initialize;
  188.     procedure InvalidateGrid;
  189.     procedure InvalidateRect(ARect: TIvGridRect);
  190.     procedure ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  191.     procedure MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  192.     procedure MoveAnchor(const NewAnchor: TIvGridCoord);
  193.     procedure MoveAndScroll(Mouse, CellHit: Integer; var DrawInfo: TIvGridDrawInfo;
  194.       var Axis: TIvGridAxisDrawInfo; Scrollbar: Integer);
  195.     procedure MoveCurrent(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  196.     procedure MoveTopLeft(ALeft, ATop: Longint);
  197.     procedure ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  198.     procedure ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  199.     procedure SelectionMoved(const OldSel: TIvGridRect);
  200.     procedure ScrollDataInfo(DX, DY: Integer; var DrawInfo: TIvGridDrawInfo);
  201.     procedure TopLeftMoved(const OldTopLeft: TIvGridCoord);
  202.     procedure UpdateScrollPos;
  203.     procedure UpdateScrollRange;
  204.     function GetColWidths(Index: Longint): Integer;
  205.     function GetRowHeights(Index: Longint): Integer;
  206.     function GetSelection: TIvGridRect;
  207.     function GetTabStops(Index: Longint): Boolean;
  208.     function GetVisibleColCount: Integer;
  209.     function GetVisibleRowCount: Integer;
  210.     function IsActiveControl: Boolean;
  211.     procedure ReadColWidths(Reader: TReader);
  212.     procedure ReadRowHeights(Reader: TReader);
  213.     procedure SetBorderStyle(Value: TBorderStyle);
  214.     procedure SetCol(Value: Longint);
  215.     procedure SetColCount(Value: Longint);
  216.     procedure SetColWidths(Index: Longint; Value: Integer);
  217.     procedure SetDefaultColWidth(Value: Integer);
  218.     procedure SetDefaultRowHeight(Value: Integer);
  219.     procedure SetEditorMode(Value: Boolean);
  220.     procedure SetFixedColor(Value: TColor);
  221.     procedure SetFixedCols(Value: Integer);
  222.     procedure SetFixedRows(Value: Integer);
  223.     procedure SetGridLineWidth(Value: Integer);
  224.     procedure SetLeftCol(Value: Longint);
  225.     procedure SetOptions(Value: TIvGridOptions);
  226.     procedure SetRow(Value: Longint);
  227.     procedure SetRowCount(Value: Longint);
  228.     procedure SetRowHeights(Index: Longint; Value: Integer);
  229.     procedure SetScrollBars(Value: TScrollStyle);
  230.     procedure SetSelection(Value: TIvGridRect);
  231.     procedure SetTabStops(Index: Longint; Value: Boolean);
  232.     procedure SetTopRow(Value: Longint);
  233.     procedure UpdateEdit;
  234.     procedure UpdateText;
  235.     procedure WriteColWidths(Writer: TWriter);
  236.     procedure WriteRowHeights(Writer: TWriter);
  237.     procedure CMCancelMode(var Msg: TMessage); message CM_CANCELMODE;
  238.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  239.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  240.     procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  241.     procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
  242.     procedure WMChar(var Msg: TWMChar); message WM_CHAR;
  243.     procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  244.     procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
  245.     procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
  246.     procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
  247.     procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
  248.     procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  249.     procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  250.     procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
  251.     procedure WMSize(var Msg: TWMSize); message WM_SIZE;
  252.     procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
  253.     procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
  254.  
  255.   protected
  256.     FGridState: TIvGridState;
  257.     FSaveCellExtents: Boolean;
  258.     DesignOptionsBoost: TIvGridOptions;
  259.     VirtualView: Boolean;
  260.  
  261.     function CreateEditor: TIvInplaceEdit; virtual;
  262.     procedure CreateParams(var Params: TCreateParams); override;
  263.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  264.     procedure KeyPress(var Key: Char); override;
  265.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  266.       X, Y: Integer); override;
  267.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  268.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  269.       X, Y: Integer); override;
  270.     procedure AdjustSize(Index, Amount: Longint; Rows: Boolean);dynamic;
  271.     function BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  272.     procedure DoExit; override;
  273.     function CellRect(ACol, ARow: Longint): TRect;
  274.     function CanEditAcceptKey(Key: Char): Boolean; dynamic;
  275.     function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean; dynamic;
  276.     function CanEditModify: Boolean; dynamic;
  277.     function CanEditShow: Boolean; virtual;
  278.     function GetEditText(ACol, ARow: Longint): string; dynamic;
  279.     procedure SetEditText(ACol, ARow: Longint; const Value: string); dynamic;
  280.     function GetEditMask(ACol, ARow: Longint): string; dynamic;
  281.     function GetEditLimit: Integer; dynamic;
  282.     function GetGridWidth: Integer;
  283.     function GetGridHeight: Integer;
  284.     procedure HideEditor;
  285.     procedure ShowEditor;
  286.     procedure ShowEditorChar(Ch: Char);
  287.     procedure InvalidateEditor;
  288.     procedure MoveColumn(FromIndex, ToIndex: Longint);
  289.     procedure ColumnMoved(FromIndex, ToIndex: Longint); dynamic;
  290.     procedure MoveRow(FromIndex, ToIndex: Longint);
  291.     procedure RowMoved(FromIndex, ToIndex: Longint); dynamic;
  292.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  293.       AState: TIvGridDrawState); virtual; abstract;
  294.     procedure DefineProperties(Filer: TFiler); override;
  295.     procedure MoveColRow(ACol, ARow: Longint; MoveAnchor, Show: Boolean);
  296.     function SelectCell(ACol, ARow: Longint): Boolean; virtual;
  297.     procedure SizeChanged(OldColCount, OldRowCount: Longint); dynamic;
  298.     function Sizing(X, Y: Integer): Boolean;
  299.     procedure ScrollData(DX, DY: Integer);
  300.     procedure InvalidateCell(ACol, ARow: Longint);
  301.     procedure InvalidateCol(ACol: Longint);
  302.     procedure InvalidateRow(ARow: Longint);
  303.     procedure TopLeftChanged; dynamic;
  304.     procedure TimedScroll(Direction: TIvGridScrollDirection); dynamic;
  305.     procedure Paint; override;
  306.     procedure ColWidthsChanged; dynamic;
  307.     procedure RowHeightsChanged; dynamic;
  308.     procedure DeleteColumn(ACol: Longint);
  309.     procedure DeleteRow(ARow: Longint);
  310.     procedure UpdateDesigner;
  311.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  312.     property Col: Longint read FCurrent.X write SetCol;
  313.     property Color default clWindow;
  314.     property ColCount: Longint read FColCount write SetColCount default 5;
  315.     property ColWidths[Index: Longint]: Integer read GetColWidths write SetColWidths;
  316.     property DefaultColWidth: Integer read FDefaultColWidth write SetDefaultColWidth default 64;
  317.     property DefaultDrawing: Boolean read FDefaultDrawing write FDefaultDrawing default True;
  318.     property DefaultRowHeight: Integer read FDefaultRowHeight write SetDefaultRowHeight default 24;
  319.     property EditorMode: Boolean read FEditorMode write SetEditorMode;
  320.     property FixedColor: TColor read FFixedColor write SetFixedColor default clBtnFace;
  321.     property FixedCols: Integer read FFixedCols write SetFixedCols default 1;
  322.     property FixedRows: Integer read FFixedRows write SetFixedRows default 1;
  323.     property GridHeight: Integer read GetGridHeight;
  324.     property GridLineWidth: Integer read FGridLineWidth write SetGridLineWidth default 1;
  325.     property GridWidth: Integer read GetGridWidth;
  326.     property HitTest: TPoint read FHitTest;
  327.     property InplaceEditor: TIvInplaceEdit read FInplaceEdit;
  328.     property LeftCol: Longint read FTopLeft.X write SetLeftCol;
  329.     property Options: TIvGridOptions read FOptions write SetOptions
  330.       default [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  331.       goRangeSelect];
  332.     property ParentColor default False;
  333.     property Row: Longint read FCurrent.Y write SetRow;
  334.     property RowCount: Longint read FRowCount write SetRowCount default 5;
  335.     property RowHeights[Index: Longint]: Integer read GetRowHeights write SetRowHeights;
  336.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
  337.     property Selection: TIvGridRect read GetSelection write SetSelection;
  338.     property TabStops[Index: Longint]: Boolean read GetTabStops write SetTabStops;
  339.     property TopRow: Longint read FTopLeft.Y write SetTopRow;
  340.     property VisibleColCount: Integer read GetVisibleColCount;
  341.     property VisibleRowCount: Integer read GetVisibleRowCount;
  342.  
  343.   public
  344.     constructor Create(AOwner: TComponent); override;
  345.     destructor Destroy; override;
  346.     function MouseCoord(X, Y: Integer): TIvGridCoord;
  347.  
  348.     property ColLocale[index: Integer]: Integer read GetColLocale write SetColLocale;
  349.  
  350.   published
  351.     property Locale: Integer read FLocale write SetLocale stored False;
  352.     property TabStop default True;
  353.   end;
  354.  
  355.   { TDrawGrid }
  356.  
  357.   TIvGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
  358.   TIvSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;
  359.   TIvMovedEvent = procedure (Sender: TObject; FromIndex, ToIndex: Longint) of object;
  360.  
  361.   TIvDrawGrid = class(TIvCustomGrid)
  362.   private
  363.     FOnColumnMoved: TIvMovedEvent;
  364.     FOnDrawCell: TIvDrawCellEvent;
  365.     FOnGetEditMask: TIvGetEditEvent;
  366.     FOnGetEditText: TIvGetEditEvent;
  367.     FOnRowMoved: TIvMovedEvent;
  368.     FOnSelectCell: TIvSelectCellEvent;
  369.     FOnSetEditText: TIvSetEditEvent;
  370.     FOnTopLeftChanged: TNotifyEvent;
  371.  
  372.   protected
  373.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  374.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  375.       AState: TIvGridDrawState); override;
  376.     function GetEditMask(ACol, ARow: Longint): string; override;
  377.     function GetEditText(ACol, ARow: Longint): string; override;
  378.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  379.     function SelectCell(ACol, ARow: Longint): Boolean; override;
  380.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  381.     procedure TopLeftChanged; override;
  382.  
  383.   public
  384.     function CellRect(ACol, ARow: Longint): TRect;
  385.     procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  386.     property Canvas;
  387.     property Col;
  388.     property ColWidths;
  389.     property EditorMode;
  390.     property GridHeight;
  391.     property GridWidth;
  392.     property LeftCol;
  393.     property Selection;
  394.     property Row;
  395.     property RowHeights;
  396.     property TabStops;
  397.     property TopRow;
  398.  
  399.   published
  400.     property Align;
  401.     property BorderStyle;
  402.     property Color;
  403.     property ColCount;
  404.     property Ctl3D;
  405.     property DefaultColWidth;
  406.     property DefaultRowHeight;
  407.     property DefaultDrawing;
  408.     property DragCursor;
  409.     property DragMode;
  410.     property Enabled;
  411.     property FixedColor;
  412.     property FixedCols;
  413.     property RowCount;
  414.     property FixedRows;
  415.     property Font;
  416.     property GridLineWidth;
  417.     property Options;
  418.     property ParentColor;
  419.     property ParentCtl3D;
  420.     property ParentFont;
  421.     property ParentShowHint;
  422.     property PopupMenu;
  423.     property ScrollBars;
  424.     property ShowHint;
  425.     property TabOrder;
  426.     property TabStop;
  427.     property Visible;
  428.     property VisibleColCount;
  429.     property VisibleRowCount;
  430.     property OnClick;
  431.     property OnColumnMoved: TIvMovedEvent read FOnColumnMoved write FOnColumnMoved;
  432.     property OnDblClick;
  433.     property OnDragDrop;
  434.     property OnDragOver;
  435.     property OnDrawCell: TIvDrawCellEvent read FOnDrawCell write FOnDrawCell;
  436.     property OnEndDrag;
  437.     property OnEnter;
  438.     property OnExit;
  439.     property OnGetEditMask: TIvGetEditEvent read FOnGetEditMask write FOnGetEditMask;
  440.     property OnGetEditText: TIvGetEditEvent read FOnGetEditText write FOnGetEditText;
  441.     property OnKeyDown;
  442.     property OnKeyPress;
  443.     property OnKeyUp;
  444.     property OnMouseDown;
  445.     property OnMouseMove;
  446.     property OnMouseUp;
  447.     property OnRowMoved: TIvMovedEvent read FOnRowMoved write FOnRowMoved;
  448.     property OnSelectCell: TIvSelectCellEvent read FOnSelectCell write FOnSelectCell;
  449.     property OnSetEditText: TIvSetEditEvent read FOnSetEditText write FOnSetEditText;
  450.     property OnStartDrag;
  451.     property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  452.   end;
  453.  
  454.   { TIvStringGrid }
  455.  
  456.   TIvStringGrid = class;
  457.  
  458.   TIvStringGridStrings = class(TStrings)
  459.   private
  460.     FGrid: TIvStringGrid;
  461.     FIndex: Integer;
  462.  
  463.     procedure CalcXY(Index: Integer; var X, Y: Integer);
  464.  
  465.   protected
  466.     function Get(Index: Integer): string; override;
  467.     function GetCount: Integer; override;
  468.     function GetObject(Index: Integer): TObject; override;
  469.     procedure Put(Index: Integer; const S: string); override;
  470.     procedure PutObject(Index: Integer; AObject: TObject); override;
  471.     procedure SetUpdateState(Updating: Boolean); override;
  472.  
  473.   public
  474.     constructor Create(AGrid: TIvStringGrid; AIndex: Longint);
  475.  
  476.     procedure Clear; override;
  477.     function Add(const S: string): Integer; override;
  478.  
  479.     procedure Assign(Source: TPersistent); override;
  480. {$IFDEF IVWIDE}
  481.     procedure Delete(Index: Integer); override;
  482.     procedure Insert(Index: Integer; const S: string); override;
  483. {$ENDIF}
  484.   end;
  485.  
  486.   TIvStringGrid = class(TIvDrawGrid)
  487.   private
  488.     FData: Pointer;
  489.     FRows: Pointer;
  490.     FCols: Pointer;
  491.     FUpdating: Boolean;
  492.     FNeedsUpdating: Boolean;
  493.     FEditUpdate: Integer;
  494.  
  495.     procedure DisableEditUpdate;
  496.     procedure EnableEditUpdate;
  497.     procedure Initialize;
  498.     procedure UpdateCell(ACol, ARow: Integer);
  499.     procedure SetUpdateState(Updating: Boolean);
  500.     function GetCells(ACol, ARow: Integer): string;
  501.     function GetCols(Index: Integer): TStrings;
  502.     function GetObjects(ACol, ARow: Integer): TObject;
  503.     function GetRows(Index: Integer): TStrings;
  504.     procedure SetCells(ACol, ARow: Integer; const Value: string);
  505.     procedure SetCols(Index: Integer; Value: TStrings);
  506.     procedure SetObjects(ACol, ARow: Integer; Value: TObject);
  507.     procedure SetRows(Index: Integer; Value: TStrings);
  508.     function EnsureColRow(Index: Integer; IsCol: Boolean): TIvStringGridStrings;
  509.     function EnsureDataRow(ARow: Integer): Pointer;
  510.  
  511.   protected
  512.     procedure ColumnMoved(FromIndex, ToIndex: Longint); override;
  513.     procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
  514.       AState: TIvGridDrawState); override;
  515.     function GetEditText(ACol, ARow: Longint): string; override;
  516.     procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
  517.     procedure RowMoved(FromIndex, ToIndex: Longint); override;
  518.  
  519.   public
  520.     constructor Create(AOwner: TComponent); override;
  521.     destructor Destroy; override;
  522.  
  523.     property Cells[ACol, ARow: Integer]: string read GetCells write SetCells;
  524.     property Cols[Index: Integer]: TStrings read GetCols write SetCols;
  525.     property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects;
  526.     property Rows[Index: Integer]: TStrings read GetRows write SetRows;
  527.   end;
  528. {$ENDIF}
  529.  
  530. implementation
  531.  
  532. {$IFNDEF IVBIDI}
  533. uses
  534.   Consts, IvDictio;
  535.  
  536. type
  537.   PIntArray = ^TIntArray;
  538.   TIntArray = array[0..IvMaxCustomExtents] of Integer;
  539.  
  540. {$IFDEF IVWIDE}
  541. procedure InvalidOp(const id: String);
  542. begin
  543.   raise EIvInvalidGridOperation.Create(id);
  544. end;
  545. {$ELSE}
  546. procedure InvalidOp(const id: Integer);
  547. begin
  548.   raise EIvInvalidGridOperation.CreateRes(id);
  549. end;
  550. {$ENDIF}
  551.  
  552. function IMin(A, B: Integer): Integer;
  553. begin
  554.   Result := B;
  555.   if A < B then Result := A;
  556. end;
  557.  
  558. function IMax(A, B: Integer): Integer;
  559. begin
  560.   Result := B;
  561.   if A > B then Result := A;
  562. end;
  563.  
  564. function GridRect(Coord1, Coord2: TIvGridCoord): TIvGridRect;
  565. begin
  566.   with Result do
  567.   begin
  568.     Left := Coord2.X;
  569.     if Coord1.X < Coord2.X then
  570.       Left := Coord1.X;
  571.  
  572.     Right := Coord1.X;
  573.     if Coord1.X < Coord2.X then
  574.       Right := Coord2.X;
  575.  
  576.     Top := Coord2.Y;
  577.     if Coord1.Y < Coord2.Y then
  578.       Top := Coord1.Y;
  579.  
  580.     Bottom := Coord1.Y;
  581.     if Coord1.Y < Coord2.Y then
  582.       Bottom := Coord2.Y;
  583.   end;
  584. end;
  585.  
  586. function PointInGridRect(Col, Row: Longint; const Rect: TIvGridRect): Boolean;
  587. begin
  588.   Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
  589.     and (Row <= Rect.Bottom);
  590. end;
  591.  
  592. type
  593.   TXorRects = array[0..3] of TRect;
  594.  
  595. procedure XorRects(const R1, R2: TRect; var XorRects: TXorRects);
  596. var
  597.   Intersect, Union: TRect;
  598.  
  599.   function PtInRect(X, Y: Integer; const Rect: TRect): Boolean;
  600.   begin
  601.     with Rect do Result := (X >= Left) and (X <= Right) and (Y >= Top) and
  602.       (Y <= Bottom);
  603.   end;
  604.  
  605.   function Includes(const P1: TPoint; var P2: TPoint): Boolean;
  606.   begin
  607.     with P1 do
  608.     begin
  609.       Result := PtInRect(X, Y, R1) or PtInRect(X, Y, R2);
  610.       if Result then P2 := P1;
  611.     end;
  612.   end;
  613.  
  614.   function Build(var R: TRect; const P1, P2, P3: TPoint): Boolean;
  615.   begin
  616.     Build := True;
  617.     with R do
  618.       if Includes(P1, TopLeft) then
  619.       begin
  620.         if not Includes(P3, BottomRight) then BottomRight := P2;
  621.       end
  622.       else if Includes(P2, TopLeft) then BottomRight := P3
  623.       else Build := False;
  624.   end;
  625.  
  626. begin
  627.   FillChar(XorRects, SizeOf(XorRects), 0);
  628.   if not Bool(IntersectRect(Intersect, R1, R2)) then
  629.   begin
  630.     { Don't intersect so its simple }
  631.     XorRects[0] := R1;
  632.     XorRects[1] := R2;
  633.   end
  634.   else
  635.   begin
  636.     UnionRect(Union, R1, R2);
  637.     if Build(XorRects[0],
  638.       Point(Union.Left, Union.Top),
  639.       Point(Union.Left, Intersect.Top),
  640.       Point(Union.Left, Intersect.Bottom)) then
  641.       XorRects[0].Right := Intersect.Left;
  642.     if Build(XorRects[1],
  643.       Point(Intersect.Left, Union.Top),
  644.       Point(Intersect.Right, Union.Top),
  645.       Point(Union.Right, Union.Top)) then
  646.       XorRects[1].Bottom := Intersect.Top;
  647.     if Build(XorRects[2],
  648.       Point(Union.Right, Intersect.Top),
  649.       Point(Union.Right, Intersect.Bottom),
  650.       Point(Union.Right, Union.Bottom)) then
  651.       XorRects[2].Left := Intersect.Right;
  652.     if Build(XorRects[3],
  653.       Point(Union.Left, Union.Bottom),
  654.       Point(Intersect.Left, Union.Bottom),
  655.       Point(Intersect.Right, Union.Bottom)) then
  656.       XorRects[3].Top := Intersect.Bottom;
  657.   end;
  658. end;
  659.  
  660. procedure ModifyExtents(var Extents: Pointer; Index, Amount: Longint;
  661.   Default: Integer);
  662. var
  663.   LongSize: LongInt;
  664.   NewSize: Cardinal;
  665.   OldSize: Cardinal;
  666.   I: Cardinal;
  667. begin
  668.   if Amount <> 0 then
  669.   begin
  670.     if not Assigned(Extents) then OldSize := 0
  671.     else OldSize := PIntArray(Extents)^[0];
  672.     if (Index < 0) or (Integer(OldSize) < Index) then
  673.       InvalidOp(SIndexOutOfRange);
  674.     LongSize := Integer(OldSize) + Amount;
  675.     if LongSize < 0 then InvalidOp(STooManyDeleted)
  676.     else if LongSize >= MaxListSize - 1 then InvalidOp(SGridTooLarge);
  677.     NewSize := Cardinal(LongSize);
  678.     if NewSize > 0 then Inc(NewSize);
  679.     ReallocMem(Extents, NewSize * SizeOf(Integer));
  680.     if Assigned(Extents) then
  681.     begin
  682.       I := Index;
  683.       while I < NewSize do
  684.       begin
  685.         PIntArray(Extents)^[I] := Default;
  686.         Inc(I);
  687.       end;
  688.       PIntArray(Extents)^[0] := NewSize-1;
  689.     end;
  690.   end;
  691. end;
  692.  
  693. procedure UpdateExtents(var Extents: Pointer; NewSize: Longint;
  694.   Default: Integer);
  695. var
  696.   OldSize: Integer;
  697. begin
  698.   OldSize := 0;
  699.   if Assigned(Extents) then OldSize := PIntArray(Extents)^[0];
  700.   ModifyExtents(Extents, OldSize, NewSize - OldSize, Default);
  701. end;
  702.  
  703. procedure MoveExtent(var Extents: Pointer; FromIndex, ToIndex: Longint);
  704. var
  705.   Extent: Integer;
  706. begin
  707.   if Assigned(Extents) then
  708.   begin
  709.     Extent := PIntArray(Extents)^[FromIndex];
  710.     if FromIndex < ToIndex then
  711.       Move(PIntArray(Extents)^[FromIndex + 1], PIntArray(Extents)^[FromIndex],
  712.         (ToIndex - FromIndex) * SizeOf(Integer))
  713.     else if FromIndex > ToIndex then
  714.       Move(PIntArray(Extents)^[ToIndex], PIntArray(Extents)^[ToIndex + 1],
  715.         (FromIndex - ToIndex) * SizeOf(Integer));
  716.     PIntArray(Extents)^[ToIndex] := Extent;
  717.   end;
  718. end;
  719.  
  720. function CompareExtents(E1, E2: Pointer): Boolean;
  721. var
  722.   I: Integer;
  723. begin
  724.   Result := False;
  725.   if E1 <> nil then
  726.   begin
  727.     if E2 <> nil then
  728.     begin
  729.       for I := 0 to PIntArray(E1)^[0] do
  730.         if PIntArray(E1)^[I] <> PIntArray(E2)^[I] then Exit;
  731.       Result := True;
  732.     end
  733.   end
  734.   else Result := E2 = nil;
  735. end;
  736.  
  737. { Private. LongMulDiv multiplys the first two arguments and then
  738.   divides by the third.  This is used so that real number
  739.   (floating point) arithmetic is not necessary.  This routine saves
  740.   the possible 64-bit value in a temp before doing the divide.  Does
  741.   not do error checking like divide by zero.  Also assumes that the
  742.   result is in the 32-bit range (Actually 31-bit, since this algorithm
  743.   is for unsigned). }
  744.  
  745. function LongMulDiv(Mult1, Mult2, Div1: Longint): Longint; stdcall;
  746.   external 'kernel32.dll' name 'MulDiv';
  747.  
  748. type
  749.   TSelection = record
  750.     StartPos, EndPos: Integer;
  751.   end;
  752.  
  753. constructor TIvInplaceEdit.Create(AOwner: TComponent);
  754. begin
  755.   inherited Create(AOwner);
  756.   ParentCtl3D := False;
  757.   Ctl3D := False;
  758.   TabStop := False;
  759.   BorderStyle := bsNone;
  760. end;
  761.  
  762. procedure TIvInplaceEdit.CreateParams(var Params: TCreateParams);
  763. begin
  764.   inherited CreateParams(Params);
  765.   Params.Style := Params.Style or ES_MULTILINE;
  766. end;
  767.  
  768. procedure TIvInplaceEdit.SetGrid(Value: TIvCustomGrid);
  769. begin
  770.   FGrid := Value;
  771. end;
  772.  
  773. procedure TIvInplaceEdit.CMShowingChanged(var Message: TMessage);
  774. begin
  775.   { Ignore showing using the Visible property }
  776. end;
  777.  
  778. procedure TIvInplaceEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
  779. begin
  780.   inherited;
  781.   if goTabs in Grid.Options then
  782.     Message.Result := Message.Result or DLGC_WANTTAB;
  783. end;
  784.  
  785. procedure TIvInplaceEdit.WMPaste(var Message);
  786. begin
  787.   if not EditCanModify then Exit;
  788.   inherited
  789. end;
  790.  
  791. procedure TIvInplaceEdit.WMClear(var Message);
  792. begin
  793.   if not EditCanModify then Exit;
  794.   inherited;
  795. end;
  796.  
  797. procedure TIvInplaceEdit.WMCut(var Message);
  798. begin
  799.   if not EditCanModify then Exit;
  800.   inherited;
  801. end;
  802.  
  803. procedure TIvInplaceEdit.DblClick;
  804. begin
  805.   Grid.DblClick;
  806. end;
  807.  
  808. function TIvInplaceEdit.EditCanModify: Boolean;
  809. begin
  810.   Result := Grid.CanEditModify;
  811. end;
  812.  
  813. procedure TIvInplaceEdit.KeyDown(var Key: Word; Shift: TShiftState);
  814.  
  815.   procedure SendToParent;
  816.   begin
  817.     Grid.KeyDown(Key, Shift);
  818.     Key := 0;
  819.   end;
  820.  
  821.   procedure ParentEvent;
  822.   var
  823.     GridKeyDown: TKeyEvent;
  824.   begin
  825.     GridKeyDown := Grid.OnKeyDown;
  826.     if Assigned(GridKeyDown) then GridKeyDown(Grid, Key, Shift);
  827.   end;
  828.  
  829.   function ForwardMovement: Boolean;
  830.   begin
  831.     Result := goAlwaysShowEditor in Grid.Options;
  832.   end;
  833.  
  834.   function Ctrl: Boolean;
  835.   begin
  836.     Result := ssCtrl in Shift;
  837.   end;
  838.  
  839.   function Selection: TSelection;
  840.   begin
  841.     SendMessage(Handle, EM_GETSEL, Longint(@Result.StartPos), Longint(@Result.EndPos));
  842.   end;
  843.  
  844.   function RightSide: Boolean;
  845.   begin
  846.     with Selection do
  847.       Result := ((StartPos = 0) or (EndPos = StartPos)) and
  848.         (EndPos = GetTextLen);
  849.    end;
  850.  
  851.   function LeftSide: Boolean;
  852.   begin
  853.     with Selection do
  854.       Result := (StartPos = 0) and ((EndPos = 0) or (EndPos = GetTextLen));
  855.   end;
  856.  
  857. begin
  858.   case Key of
  859.     VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT, VK_ESCAPE: SendToParent;
  860.     VK_INSERT:
  861.       if Shift = [] then SendToParent
  862.       else if (Shift = [ssShift]) and not Grid.CanEditModify then Key := 0;
  863.     VK_LEFT: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  864.     VK_RIGHT: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  865.     VK_HOME: if ForwardMovement and (Ctrl or LeftSide) then SendToParent;
  866.     VK_END: if ForwardMovement and (Ctrl or RightSide) then SendToParent;
  867.     VK_F2:
  868.       begin
  869.         ParentEvent;
  870.         if Key = VK_F2 then
  871.         begin
  872.           Deselect;
  873.           Exit;
  874.         end;
  875.       end;
  876.     VK_TAB: if not (ssAlt in Shift) then SendToParent;
  877.   end;
  878.   if (Key = VK_DELETE) and not Grid.CanEditModify then Key := 0;
  879.   if Key <> 0 then
  880.   begin
  881.     ParentEvent;
  882.     inherited KeyDown(Key, Shift);
  883.   end;
  884. end;
  885.  
  886. procedure TIvInplaceEdit.KeyPress(var Key: Char);
  887. var
  888.   Selection: TSelection;
  889. begin
  890.   Grid.KeyPress(Key);
  891.   if (Key in [#32..#255]) and not Grid.CanEditAcceptKey(Key) then
  892.   begin
  893.     Key := #0;
  894.     MessageBeep(0);
  895.   end;
  896.   case Key of
  897.     #9, #27: Key := #0;
  898.     #13:
  899.       begin
  900.         SendMessage(Handle, EM_GETSEL, Longint(@Selection.StartPos), Longint(@Selection.EndPos));
  901.         if (Selection.StartPos = 0) and (Selection.EndPos = GetTextLen) then
  902.           Deselect else
  903.           SelectAll;
  904.         Key := #0;
  905.       end;
  906.     ^H, ^V, ^X, #32..#255:
  907.       if not Grid.CanEditModify then Key := #0;
  908.   end;
  909.   if Key <> #0 then inherited KeyPress(Key);
  910. end;
  911.  
  912. procedure TIvInplaceEdit.KeyUp(var Key: Word; Shift: TShiftState);
  913. begin
  914.   Grid.KeyUp(Key, Shift);
  915. end;
  916.  
  917. procedure TIvInplaceEdit.WndProc(var Message: TMessage);
  918. begin
  919.   case Message.Msg of
  920.     WM_SETFOCUS:
  921.       begin
  922.         if (GetParentForm(Self) = nil) or GetParentForm(Self).SetFocusedControl(Grid) then Dispatch(Message);
  923.         Exit;
  924.       end;
  925.     WM_LBUTTONDOWN:
  926.       begin
  927.         if GetMessageTime - FClickTime < GetDoubleClickTime then
  928.           Message.Msg := WM_LBUTTONDBLCLK;
  929.         FClickTime := 0;
  930.       end;
  931.   end;
  932.   inherited WndProc(Message);
  933. end;
  934.  
  935. procedure TIvInplaceEdit.Deselect;
  936. begin
  937.   SendMessage(Handle, EM_SETSEL, $7FFFFFFF, Longint($FFFFFFFF));
  938. end;
  939.  
  940. procedure TIvInplaceEdit.Invalidate;
  941. var
  942.   Cur: TRect;
  943. begin
  944.   ValidateRect(Handle, nil);
  945.   InvalidateRect(Handle, nil, True);
  946.   Windows.GetClientRect(Handle, Cur);
  947.   MapWindowPoints(Handle, Grid.Handle, Cur, 2);
  948.   ValidateRect(Grid.Handle, @Cur);
  949.   InvalidateRect(Grid.Handle, @Cur, False);
  950. end;
  951.  
  952. procedure TIvInplaceEdit.Hide;
  953. begin
  954.   if HandleAllocated and IsWindowVisible(Handle) then
  955.   begin
  956.     Invalidate;
  957.     SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_HIDEWINDOW or SWP_NOZORDER or
  958.       SWP_NOREDRAW);
  959.     if Focused then Windows.SetFocus(Grid.Handle);
  960.   end;
  961. end;
  962.  
  963. function TIvInplaceEdit.PosEqual(const Rect: TRect): Boolean;
  964. var
  965.   Cur: TRect;
  966. begin
  967.   GetWindowRect(Handle, Cur);
  968.   MapWindowPoints(HWND_DESKTOP, Grid.Handle, Cur, 2);
  969.   Result := EqualRect(Rect, Cur);
  970. end;
  971.  
  972. procedure TIvInplaceEdit.InternalMove(const Loc: TRect; Redraw: Boolean);
  973. begin
  974.   if IsRectEmpty(Loc) then Hide
  975.   else
  976.   begin
  977.     CreateHandle;
  978.     Redraw := Redraw or not IsWindowVisible(Handle);
  979.     Invalidate;
  980.     with Loc do
  981.       SetWindowPos(Handle, HWND_TOP, Left, Top, Right - Left, Bottom - Top,
  982.         SWP_SHOWWINDOW or SWP_NOREDRAW);
  983.     BoundsChanged;
  984.     if Redraw then Invalidate;
  985.     if Grid.Focused then
  986.       Windows.SetFocus(Handle);
  987.   end;
  988. end;
  989.  
  990. procedure TIvInplaceEdit.BoundsChanged;
  991. var
  992.   R: TRect;
  993. begin
  994.   R := Rect(2, 2, Width - 2, Height);
  995.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  996.   SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  997. end;
  998.  
  999. procedure TIvInplaceEdit.UpdateLoc(const Loc: TRect);
  1000. begin
  1001.   InternalMove(Loc, False);
  1002. end;
  1003.  
  1004. procedure TIvInplaceEdit.UpdateBidi(value: Boolean);
  1005. var
  1006.   style, newStyle: Integer;
  1007. begin
  1008.   { Extended style }
  1009.  
  1010.   style := GetWindowLong(Handle, GWL_EXSTYLE);
  1011.   if value then
  1012.     newStyle := style or WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR or WS_EX_RTLREADING
  1013.   else
  1014.     newStyle := style and not (WS_EX_RIGHT or WS_EX_LEFTSCROLLBAR or WS_EX_RTLREADING);
  1015.   if newStyle <> style then
  1016.     SetWindowLong(Handle, GWL_EXSTYLE, newStyle);
  1017. end;
  1018.  
  1019. function TIvInplaceEdit.Visible: Boolean;
  1020. begin
  1021.   Result := IsWindowVisible(Handle);
  1022. end;
  1023.  
  1024. procedure TIvInplaceEdit.Move(const Loc: TRect);
  1025. begin
  1026.   InternalMove(Loc, True);
  1027. end;
  1028.  
  1029. procedure TIvInplaceEdit.SetFocus;
  1030. begin
  1031.   if IsWindowVisible(Handle) then
  1032.     Windows.SetFocus(Handle);
  1033. end;
  1034.  
  1035. procedure TIvInplaceEdit.UpdateContents;
  1036. begin
  1037.   Text := '';
  1038.   EditMask := Grid.GetEditMask(Grid.Col, Grid.Row);
  1039.   Text := Grid.GetEditText(Grid.Col, Grid.Row);
  1040.   MaxLength := Grid.GetEditLimit;
  1041. end;
  1042.  
  1043. { TIvCustomGrid }
  1044.  
  1045. constructor TIvCustomGrid.Create(AOwner: TComponent);
  1046. const
  1047.   GridStyle = [csCaptureMouse, csOpaque, csDoubleClicks];
  1048. begin
  1049.   inherited Create(AOwner);
  1050.   if NewStyleControls then
  1051.     ControlStyle := GridStyle else
  1052.     ControlStyle := GridStyle + [csFramed];
  1053.   FCanEditModify := True;
  1054.   FColCount := 5;
  1055.   FRowCount := 5;
  1056.   FFixedCols := 1;
  1057.   FFixedRows := 1;
  1058.   FGridLineWidth := 1;
  1059.   FOptions := [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
  1060.     goRangeSelect];
  1061.   DesignOptionsBoost := [goColSizing, goRowSizing];
  1062.   FFixedColor := clBtnFace;
  1063.   FScrollBars := ssBoth;
  1064.   FBorderStyle := bsSingle;
  1065.   FDefaultColWidth := 64;
  1066.   FDefaultRowHeight := 24;
  1067.   FDefaultDrawing := True;
  1068.   FSaveCellExtents := True;
  1069.   FEditorMode := False;
  1070.  
  1071.   FLocale := 0;
  1072.   FColLocale := TList.Create;
  1073.   while FColLocale.Count < FColCount do
  1074.     FColLocale.Add(Pointer(0));
  1075.  
  1076.   Color := clWindow;
  1077.   ParentColor := False;
  1078.   TabStop := True;
  1079.   SetBounds(
  1080.     Left,
  1081.     Top,
  1082.     FColCount*FDefaultColWidth,
  1083.     FRowCount*FDefaultRowHeight);
  1084.   Initialize;
  1085. end;
  1086.  
  1087. destructor TIvCustomGrid.Destroy;
  1088. begin
  1089.   while FColLocale.Count > 0 do
  1090.     FColLocale.Delete(0);
  1091.   FColLocale.Free;
  1092.  
  1093.   FInplaceEdit.Free;
  1094.   inherited Destroy;
  1095.   FreeMem(FColWidths);
  1096.   FreeMem(FRowHeights);
  1097.   FreeMem(FTabStops);
  1098. end;
  1099.  
  1100. procedure TIvCustomGrid.SetLocale(value: Integer);
  1101. begin
  1102.   if value <> FLocale then
  1103.   begin
  1104.     FLocale := value;
  1105.     Invalidate;
  1106.   end;
  1107. end;
  1108.  
  1109. function TIvCustomGrid.GetColLocale(index: Integer): Integer;
  1110. begin
  1111.   Result := Integer(FColLocale[index]);
  1112.   if Result = 0 then
  1113.     Result := Locale;
  1114. end;
  1115.  
  1116. procedure TIvCustomGrid.SetColLocale(index: Integer; value: Integer);
  1117. begin
  1118.   if value <> ColLocale[index] then
  1119.   begin
  1120.     FColLocale[index] := Pointer(value);
  1121.     Invalidate;
  1122.   end;
  1123. end;
  1124.  
  1125. procedure TIvCustomGrid.AdjustSize(Index, Amount: Longint; Rows: Boolean);
  1126. var
  1127.   NewCur: TIvGridCoord;
  1128.   OldRows, OldCols: Longint;
  1129.   MovementX, MovementY: Longint;
  1130.   MoveRect: TIvGridRect;
  1131.   ScrollArea: TRect;
  1132.   AbsAmount: Longint;
  1133.  
  1134.   function DoSizeAdjust(var Count: Longint; var Extents: Pointer;
  1135.     DefaultExtent: Integer; var Current: Longint): Longint;
  1136.   var
  1137.     I: Integer;
  1138.     NewCount: Longint;
  1139.   begin
  1140.     NewCount := Count + Amount;
  1141.     if NewCount < Index then InvalidOp(STooManyDeleted);
  1142.     if (Amount < 0) and Assigned(Extents) then
  1143.     begin
  1144.       Result := 0;
  1145.       for I := Index to Index - Amount - 1 do
  1146.         Inc(Result, PIntArray(Extents)^[I]);
  1147.     end
  1148.     else
  1149.       Result := Amount * DefaultExtent;
  1150.     if Extents <> nil then
  1151.       ModifyExtents(Extents, Index, Amount, DefaultExtent);
  1152.     Count := NewCount;
  1153.     if Current >= Index then
  1154.       if (Amount < 0) and (Current < Index - Amount) then Current := Index
  1155.       else Inc(Current, Amount);
  1156.   end;
  1157.  
  1158. begin
  1159.   if Amount = 0 then
  1160.     Exit;
  1161.   NewCur := FCurrent;
  1162.   OldCols := ColCount;
  1163.   OldRows := RowCount;
  1164.   MoveRect.Left := FixedCols;
  1165.   MoveRect.Right := ColCount - 1;
  1166.   MoveRect.Top := FixedRows;
  1167.   MoveRect.Bottom := RowCount - 1;
  1168.   MovementX := 0;
  1169.   MovementY := 0;
  1170.   AbsAmount := Amount;
  1171.   if AbsAmount < 0 then AbsAmount := -AbsAmount;
  1172.   if Rows then
  1173.   begin
  1174.     MovementY := DoSizeAdjust(FRowCount, FRowHeights, DefaultRowHeight, NewCur.Y);
  1175.     MoveRect.Top := Index;
  1176.     if Index + AbsAmount <= TopRow then
  1177.       MoveRect.Bottom := TopRow - 1;
  1178.   end
  1179.   else
  1180.   begin
  1181.     MovementX := DoSizeAdjust(FColCount, FColWidths, DefaultColWidth, NewCur.X);
  1182.     MoveRect.Left := Index;
  1183.     if Index + AbsAmount <= LeftCol then
  1184.       MoveRect.Right := LeftCol - 1;
  1185.   end;
  1186.   GridRectToScreenRect(MoveRect, ScrollArea, True);
  1187.   if not IsRectEmpty(ScrollArea) then
  1188.   begin
  1189.     ScrollWindow(Handle, MovementX, MovementY, @ScrollArea, @ScrollArea);
  1190.     UpdateWindow(Handle);
  1191.   end;
  1192.   SizeChanged(OldCols, OldRows);
  1193.   if (NewCur.X <> FCurrent.X) or (NewCur.Y <> FCurrent.Y) then
  1194.     MoveCurrent(NewCur.X, NewCur.Y, True, True);
  1195. end;
  1196.  
  1197. function TIvCustomGrid.BoxRect(ALeft, ATop, ARight, ABottom: Longint): TRect;
  1198. var
  1199.   gridRect: TIvGridRect;
  1200. begin
  1201.   gridRect.Left := ALeft;
  1202.   gridRect.Right := ARight;
  1203.   gridRect.Top := ATop;
  1204.   gridRect.Bottom := ABottom;
  1205.   GridRectToScreenRect(gridRect, Result, False);
  1206. end;
  1207.  
  1208. procedure TIvCustomGrid.DoExit;
  1209. begin
  1210.   inherited DoExit;
  1211.   if not (goAlwaysShowEditor in Options) then
  1212.     HideEditor;
  1213. end;
  1214.  
  1215. function TIvCustomGrid.CellRect(ACol, ARow: Longint): TRect;
  1216. begin
  1217.   Result := BoxRect(ACol, ARow, ACol, ARow);
  1218. end;
  1219.  
  1220. function TIvCustomGrid.CanEditAcceptKey(Key: Char): Boolean;
  1221. begin
  1222.   Result := True;
  1223. end;
  1224.  
  1225. function TIvCustomGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
  1226. begin
  1227.   Result := True;
  1228. end;
  1229.  
  1230. function TIvCustomGrid.CanEditModify: Boolean;
  1231. begin
  1232.   Result := FCanEditModify;
  1233. end;
  1234.  
  1235. function TIvCustomGrid.CanEditShow: Boolean;
  1236. begin
  1237.   Result := ([goRowSelect, goEditing]*Options = [goEditing]) and
  1238.     FEditorMode and not (csDesigning in ComponentState) and HandleAllocated and
  1239.     ((goAlwaysShowEditor in Options) or IsActiveControl);
  1240. end;
  1241.  
  1242. function TIvCustomGrid.IsActiveControl: Boolean;
  1243. {$IFDEF IVWIDE}
  1244. var
  1245.   H: Hwnd;
  1246.   ParentForm: TCustomForm;
  1247. {$ENDIF}
  1248. begin
  1249. {$IFDEF IVWIDE}
  1250.   Result := False;
  1251.   ParentForm := GetParentForm(Self);
  1252.   if Assigned(ParentForm) then
  1253.   begin
  1254.     if (ParentForm.ActiveControl = Self) then
  1255.       Result := True
  1256.   end
  1257.   else
  1258.   begin
  1259.     H := GetFocus;
  1260.     while IsWindow(H) and (Result = False) do
  1261.     begin
  1262.       if H = WindowHandle then
  1263.         Result := True
  1264.       else
  1265.         H := GetParent(H);
  1266.     end;
  1267.   end;
  1268. {$ELSE}
  1269.   Result := ValidParentForm(Self).ActiveControl = Self;
  1270. {$ENDIF}
  1271. end;
  1272.  
  1273. function TIvCustomGrid.GetEditMask(ACol, ARow: Longint): string;
  1274. begin
  1275.   Result := '';
  1276. end;
  1277.  
  1278. function TIvCustomGrid.GetEditText(ACol, ARow: Longint): string;
  1279. begin
  1280.   Result := '';
  1281. end;
  1282.  
  1283. procedure TIvCustomGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  1284. begin
  1285. end;
  1286.  
  1287. function TIvCustomGrid.GetEditLimit: Integer;
  1288. begin
  1289.   Result := 0;
  1290. end;
  1291.  
  1292. procedure TIvCustomGrid.HideEditor;
  1293. begin
  1294.   FEditorMode := False;
  1295.   HideEdit;
  1296. end;
  1297.  
  1298. procedure TIvCustomGrid.ShowEditor;
  1299. begin
  1300.   FEditorMode := True;
  1301.   UpdateEdit;
  1302. end;
  1303.  
  1304. procedure TIvCustomGrid.ShowEditorChar(Ch: Char);
  1305. begin
  1306.   ShowEditor;
  1307.   if FInplaceEdit <> nil then
  1308.     PostMessage(FInplaceEdit.Handle, WM_CHAR, Word(Ch), 0);
  1309. end;
  1310.  
  1311. procedure TIvCustomGrid.InvalidateEditor;
  1312. begin
  1313.   FInplaceCol := -1;
  1314.   FInplaceRow := -1;
  1315.   UpdateEdit;
  1316. end;
  1317.  
  1318. procedure TIvCustomGrid.ReadColWidths(Reader: TReader);
  1319. var
  1320.   I: Integer;
  1321. begin
  1322.   with Reader do
  1323.   begin
  1324.     ReadListBegin;
  1325.     for I := 0 to ColCount - 1 do ColWidths[I] := ReadInteger;
  1326.     ReadListEnd;
  1327.   end;
  1328. end;
  1329.  
  1330. procedure TIvCustomGrid.ReadRowHeights(Reader: TReader);
  1331. var
  1332.   I: Integer;
  1333. begin
  1334.   with Reader do
  1335.   begin
  1336.     ReadListBegin;
  1337.     for I := 0 to RowCount - 1 do RowHeights[I] := ReadInteger;
  1338.     ReadListEnd;
  1339.   end;
  1340. end;
  1341.  
  1342. procedure TIvCustomGrid.WriteColWidths(Writer: TWriter);
  1343. var
  1344.   I: Integer;
  1345. begin
  1346.   with Writer do
  1347.   begin
  1348.     WriteListBegin;
  1349.     for I := 0 to ColCount - 1 do WriteInteger(ColWidths[I]);
  1350.     WriteListEnd;
  1351.   end;
  1352. end;
  1353.  
  1354. procedure TIvCustomGrid.WriteRowHeights(Writer: TWriter);
  1355. var
  1356.   I: Integer;
  1357. begin
  1358.   with Writer do
  1359.   begin
  1360.     WriteListBegin;
  1361.     for I := 0 to RowCount - 1 do WriteInteger(RowHeights[I]);
  1362.     WriteListEnd;
  1363.   end;
  1364. end;
  1365.  
  1366. procedure TIvCustomGrid.DefineProperties(Filer: TFiler);
  1367.  
  1368.   function DoColWidths: Boolean;
  1369.   begin
  1370.     if Filer.Ancestor <> nil then
  1371.       Result := not CompareExtents(TIvCustomGrid(Filer.Ancestor).FColWidths, FColWidths)
  1372.     else
  1373.       Result := FColWidths <> nil;
  1374.   end;
  1375.  
  1376.   function DoRowHeights: Boolean;
  1377.   begin
  1378.     if Filer.Ancestor <> nil then
  1379.       Result := not CompareExtents(TIvCustomGrid(Filer.Ancestor).FRowHeights, FRowHeights)
  1380.     else
  1381.       Result := FRowHeights <> nil;
  1382.   end;
  1383.  
  1384.  
  1385. begin
  1386.   inherited DefineProperties(Filer);
  1387.   if FSaveCellExtents then
  1388.     with Filer do
  1389.     begin
  1390.       DefineProperty('ColWidths', ReadColWidths, WriteColWidths, DoColWidths);
  1391.       DefineProperty('RowHeights', ReadRowHeights, WriteRowHeights, DoRowHeights);
  1392.     end;
  1393. end;
  1394.  
  1395. procedure TIvCustomGrid.MoveColumn(FromIndex, ToIndex: Longint);
  1396. var
  1397.   Rect: TIvGridRect;
  1398. begin
  1399.   if FromIndex = ToIndex then
  1400.     Exit;
  1401.  
  1402.   if Assigned(FColWidths) then
  1403.   begin
  1404.     MoveExtent(FColWidths, FromIndex + 1, ToIndex + 1);
  1405.     MoveExtent(FTabStops, FromIndex + 1, ToIndex + 1);
  1406.   end;
  1407.   MoveAdjust(FCurrent.X, FromIndex, ToIndex);
  1408.   MoveAdjust(FAnchor.X, FromIndex, ToIndex);
  1409.   MoveAdjust(FInplaceCol, FromIndex, ToIndex);
  1410.   Rect.Top := 0;
  1411.   Rect.Bottom := VisibleRowCount;
  1412.   if FromIndex < ToIndex then
  1413.   begin
  1414.     Rect.Left := FromIndex;
  1415.     Rect.Right := ToIndex;
  1416.   end
  1417.   else
  1418.   begin
  1419.     Rect.Left := ToIndex;
  1420.     Rect.Right := FromIndex;
  1421.   end;
  1422.   InvalidateRect(Rect);
  1423.   ColumnMoved(FromIndex, ToIndex);
  1424.   if Assigned(FColWidths) then
  1425.     ColWidthsChanged;
  1426.   UpdateEdit;
  1427. end;
  1428.  
  1429. procedure TIvCustomGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  1430. begin
  1431. end;
  1432.  
  1433. procedure TIvCustomGrid.MoveRow(FromIndex, ToIndex: Longint);
  1434. begin
  1435.   if Assigned(FRowHeights) then
  1436.     MoveExtent(FRowHeights, FromIndex + 1, ToIndex + 1);
  1437.   MoveAdjust(FCurrent.Y, FromIndex, ToIndex);
  1438.   MoveAdjust(FAnchor.Y, FromIndex, ToIndex);
  1439.   MoveAdjust(FInplaceRow, FromIndex, ToIndex);
  1440.   RowMoved(FromIndex, ToIndex);
  1441.   if Assigned(FRowHeights) then
  1442.     RowHeightsChanged;
  1443.   UpdateEdit;
  1444. end;
  1445.  
  1446. procedure TIvCustomGrid.RowMoved(FromIndex, ToIndex: Longint);
  1447. begin
  1448. end;
  1449.  
  1450. function TIvCustomGrid.MouseCoord(X, Y: Integer): TIvGridCoord;
  1451. var
  1452.   DrawInfo: TIvGridDrawInfo;
  1453. begin
  1454.   CalcDrawInfo(DrawInfo);
  1455.   Result := CalcCoordFromPoint(X, Y, DrawInfo);
  1456.   if Result.X < 0 then Result.Y := -1
  1457.   else if Result.Y < 0 then Result.X := -1;
  1458. end;
  1459.  
  1460. procedure TIvCustomGrid.MoveColRow(ACol, ARow: Longint; MoveAnchor,
  1461.   Show: Boolean);
  1462. begin
  1463.   MoveCurrent(ACol, ARow, MoveAnchor, Show);
  1464. end;
  1465.  
  1466. function TIvCustomGrid.SelectCell(ACol, ARow: Longint): Boolean;
  1467. begin
  1468.   Result := True;
  1469. end;
  1470.  
  1471. procedure TIvCustomGrid.SizeChanged(OldColCount, OldRowCount: Longint);
  1472. begin
  1473. end;
  1474.  
  1475. function TIvCustomGrid.Sizing(X, Y: Integer): Boolean;
  1476. var
  1477.   DrawInfo: TIvGridDrawInfo;
  1478.   State: TIvGridState;
  1479.   Index: Longint;
  1480.   Pos, Ofs: Integer;
  1481. begin
  1482.   State := FGridState;
  1483.   if State = gsNormal then
  1484.   begin
  1485.     CalcDrawInfo(DrawInfo);
  1486.     CalcSizingState(X, Y, State, Index, Pos, Ofs, DrawInfo);
  1487.   end;
  1488.   Result := State <> gsNormal;
  1489. end;
  1490.  
  1491. procedure TIvCustomGrid.TopLeftChanged;
  1492. begin
  1493.   if FEditorMode and (FInplaceEdit <> nil) then
  1494.     FInplaceEdit.UpdateLoc(CellRect(Col, Row));
  1495. end;
  1496.  
  1497. procedure FillDWord(var Dest; Count, Value: Integer); register;
  1498. asm
  1499.   XCHG  EDX, ECX
  1500.   PUSH  EDI
  1501.   MOV   EDI, EAX
  1502.   MOV   EAX, EDX
  1503.   REP   STOSD
  1504.   POP   EDI
  1505. end;
  1506.  
  1507. { StackAlloc allocates a 'small' block of memory from the stack by
  1508.   decrementing SP.  This provides the allocation speed of a local variable,
  1509.   but the runtime size flexibility of heap allocated memory.  }
  1510. function StackAlloc(Size: Integer): Pointer; register;
  1511. asm
  1512.   POP   ECX          { return address }
  1513.   MOV   EDX, ESP
  1514.   ADD   EAX, 3
  1515.   AND   EAX, not 3   // round up to keep ESP dword aligned
  1516.   CMP   EAX, 4092
  1517.   JLE   @@2
  1518. @@1:
  1519.   SUB   ESP, 4092
  1520.   PUSH  EAX          { make sure we touch guard page, to grow stack }
  1521.   SUB   EAX, 4096
  1522.   JNS   @@1
  1523.   ADD   EAX, 4096
  1524. @@2:
  1525.   SUB   ESP, EAX
  1526.   MOV   EAX, ESP     { function result = low memory address of block }
  1527.   PUSH  EDX          { save original SP, for cleanup }
  1528.   MOV   EDX, ESP
  1529.   SUB   EDX, 4
  1530.   PUSH  EDX          { save current SP, for sanity check  (sp = [sp]) }
  1531.   PUSH  ECX          { return to caller }
  1532. end;
  1533.  
  1534. { StackFree pops the memory allocated by StackAlloc off the stack.
  1535. - Calling StackFree is optional - SP will be restored when the calling routine
  1536.   exits, but it's a good idea to free the stack allocated memory ASAP anyway.
  1537. - StackFree must be called in the same stack context as StackAlloc - not in
  1538.   a subroutine or finally block.
  1539. - Multiple StackFree calls must occur in reverse order of their corresponding
  1540.   StackAlloc calls.
  1541. - Built-in sanity checks guarantee that an improper call to StackFree will not
  1542.   corrupt the stack. Worst case is that the stack block is not released until
  1543.   the calling routine exits. }
  1544. procedure StackFree(P: Pointer); register;
  1545. asm
  1546.   POP   ECX                     { return address }
  1547.   MOV   EDX, DWORD PTR [ESP]
  1548.   SUB   EAX, 8
  1549.   CMP   EDX, ESP                { sanity check #1 (SP = [SP]) }
  1550.   JNE   @@1
  1551.   CMP   EDX, EAX                { sanity check #2 (P = this stack block) }
  1552.   JNE   @@1
  1553.   MOV   ESP, DWORD PTR [ESP+4]  { restore previous SP  }
  1554. @@1:
  1555.   PUSH  ECX                     { return to caller }
  1556. end;
  1557.  
  1558. procedure TIvCustomGrid.Paint;
  1559. var
  1560.   LineColor: TColor;
  1561.   drawInfo: TIvGridDrawInfo;
  1562.   Sel: TIvGridRect;
  1563.   UpdateRect: TRect;
  1564.   FocRect: TRect;
  1565.   PointsList: PIntArray;
  1566.   StrokeList: PIntArray;
  1567.   MaxStroke: Integer;
  1568.   FrameFlags1, FrameFlags2: DWORD;
  1569.  
  1570.   procedure DrawLines(
  1571.     DoHorz, DoVert: Boolean;
  1572.     Col, Row: Longint;
  1573.     const CellBounds: array of Integer;
  1574.     OnColor, OffColor: TColor);
  1575.  
  1576.   { Cellbounds is 4 integers: StartX, StartY, StopX, StopY
  1577.     Horizontal lines:  MajorIndex = 0
  1578.     Vertical lines:    MajorIndex = 1 }
  1579.  
  1580.   const
  1581.     FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;
  1582.  
  1583.     procedure DrawAxisLines(
  1584.       const AxisInfo: TIvGridAxisDrawInfo;
  1585.       horiz: Boolean;
  1586.       Cell, MajorIndex: Integer;
  1587.       UseOnColor: Boolean);
  1588.     var
  1589.       Line: Integer;
  1590.       LogBrush: TLOGBRUSH;
  1591.       Index: Integer;
  1592.       Points: PIntArray;
  1593.       StopMajor, StartMinor, StopMinor: Integer;
  1594.     begin
  1595.       with Canvas, AxisInfo do
  1596.       begin
  1597.         if EffectiveLineWidth <> 0 then
  1598.         begin
  1599.           Pen.Width := GridLineWidth;
  1600.           if UseOnColor then
  1601.             Pen.Color := OnColor
  1602.           else
  1603.             Pen.Color := OffColor;
  1604.           if Pen.Width > 1 then
  1605.           begin
  1606.             LogBrush.lbStyle := BS_Solid;
  1607.             LogBrush.lbColor := Pen.Color;
  1608.             LogBrush.lbHatch := 0;
  1609.             Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
  1610.           end;
  1611.           Points := PointsList;
  1612.           Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
  1613.             GetExtent(Cell);
  1614.           StartMinor := CellBounds[MajorIndex xor 1];
  1615.           StopMinor := CellBounds[2 + (MajorIndex xor 1)];
  1616.           StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
  1617.           Index := 0;
  1618.           repeat
  1619. {$IFDEF IVPRO32}
  1620.             if IvIsLocaleBidirectional(FLocale) then
  1621.             begin
  1622.               if horiz then
  1623.               begin
  1624.                 Points^[Index + MajorIndex] := ClientWidth - Line - 1;  { MoveTo }
  1625.                 Points^[Index + (MajorIndex xor 1)] :=  StartMinor;
  1626.                 Inc(Index, 2);
  1627.                 Points^[Index + MajorIndex] := ClientWidth - Line - 1;  { LineTo }
  1628.                 Points^[Index + (MajorIndex xor 1)] := StopMinor;
  1629.                 Inc(Index, 2);
  1630.               end
  1631.               else
  1632.               begin
  1633.                 Points^[Index + MajorIndex] := Line;  { MoveTo }
  1634.                 Points^[Index + (MajorIndex xor 1)] := ClientWidth - StartMinor;
  1635.                 Inc(Index, 2);
  1636.                 Points^[Index + MajorIndex] := Line;  { LineTo }
  1637.                 Points^[Index + (MajorIndex xor 1)] := ClientWidth - StopMinor;
  1638.                 Inc(Index, 2);
  1639.               end;
  1640.             end
  1641.             else
  1642. {$ENDIF}
  1643.             begin
  1644.               Points^[Index + MajorIndex] := Line;         { MoveTo }
  1645.               Points^[Index + (MajorIndex xor 1)] := StartMinor;
  1646.               Inc(Index, 2);
  1647.               Points^[Index + MajorIndex] := Line;         { LineTo }
  1648.               Points^[Index + (MajorIndex xor 1)] := StopMinor;
  1649.               Inc(Index, 2);
  1650.             end;
  1651.             Inc(Cell);
  1652.             Inc(Line, GetExtent(Cell) + EffectiveLineWidth);
  1653.           until Line > StopMajor;
  1654.            { 2 integers per point, 2 points per line -> Index div 4 }
  1655.           PolyPolyLine(Canvas.Handle, Points^, StrokeList^, Index shr 2);
  1656.         end;
  1657.       end;
  1658.     end;
  1659.  
  1660.   begin
  1661.     if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then
  1662.       Exit;
  1663.  
  1664.     if not DoHorz then
  1665.     begin
  1666.       DrawAxisLines(DrawInfo.Vert, False, Row, 1, DoHorz);
  1667.       DrawAxisLines(DrawInfo.Horz, True, Col, 0, DoVert);
  1668.     end
  1669.     else
  1670.     begin
  1671.       DrawAxisLines(DrawInfo.Horz, True, Col, 0, DoVert);
  1672.       DrawAxisLines(DrawInfo.Vert, False, Row, 1, DoHorz);
  1673.     end;
  1674.   end;
  1675.  
  1676.   procedure DrawCells(
  1677.     aCol, aRow: Longint;
  1678.     startX, startY, stopX, stopY: Integer;
  1679.     color: TColor;
  1680.     includeDrawState: TIvGridDrawState);
  1681.   var
  1682.     curCol, curRow: Longint;
  1683.     where, tempRect: TRect;
  1684.     drawState: TIvGridDrawState;
  1685.     focused: Boolean;
  1686.   begin
  1687. {$IFDEF IVPRO32}
  1688.     if IvIsLocaleBidirectional(FLocale) then
  1689.     begin
  1690.       // Right-aligned grid
  1691.  
  1692.       startX := ClientWidth - startX;
  1693.       stopX := ClientWidth - stopX;
  1694.  
  1695.       curRow := aRow;
  1696.       where.Top := startY;
  1697.       while (where.Top < stopY) and (curRow < rowCount) do
  1698.       begin
  1699.         curCol := aCol;
  1700.         where.Left := startX - ColWidths[curCol];
  1701.         where.Right := where.Left + ColWidths[curCol];
  1702.         where.Bottom := where.Top + RowHeights[curRow];
  1703.  
  1704.         while (where.Right > stopX) and (curCol < colCount) do
  1705.         begin
  1706.           if RectVisible(Canvas.Handle, Where) then
  1707.           begin
  1708.             DrawState := IncludeDrawState;
  1709.             Focused := IsActiveControl;
  1710.             if Focused and (CurRow = Row) and (CurCol = Col)  then
  1711.               Include(DrawState, gdFocused);
  1712.             if PointInGridRect(CurCol, CurRow, Sel) then
  1713.               Include(DrawState, gdSelected);
  1714.  
  1715.             if not (gdFocused in DrawState) or not (goEditing in Options) or
  1716.               not FEditorMode or (csDesigning in ComponentState) then
  1717.             begin
  1718.               if DefaultDrawing or (csDesigning in ComponentState) then
  1719.               begin
  1720.                 with Canvas do
  1721.                 begin
  1722.                   Font := Self.Font;
  1723.                   if (gdSelected in DrawState) and
  1724.                     (not (gdFocused in DrawState) or
  1725.                     ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
  1726.                   begin
  1727.                     Brush.Color := clHighlight;
  1728.                     Font.Color := clHighlightText;
  1729.                   end
  1730.                   else
  1731.                     Brush.Color := Color;
  1732.                   FillRect(where);
  1733.                 end;
  1734.               end;
  1735.  
  1736.               DrawCell(curCol, curRow, where, drawState);
  1737.  
  1738.               if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
  1739.                 ((FrameFlags1 or FrameFlags2) <> 0) then
  1740.               begin
  1741.                 tempRect := where;
  1742.                 if (FrameFlags1 and BF_RIGHT) = 0 then
  1743.                   Inc(tempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
  1744.                 else if (FrameFlags1 and BF_BOTTOM) = 0 then
  1745.                   Inc(tempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
  1746.                 DrawEdge(Canvas.Handle, tempRect, BDR_RAISEDINNER, FrameFlags1);
  1747.                 DrawEdge(Canvas.Handle, tempRect, BDR_RAISEDINNER, FrameFlags2);
  1748.               end;
  1749.  
  1750.               if DefaultDrawing and not (csDesigning in ComponentState) and
  1751.                 (gdFocused in DrawState) and
  1752.                 ([goEditing, goAlwaysShowEditor]*Options <> [goEditing, goAlwaysShowEditor]) and
  1753.                 not (goRowSelect in Options) then
  1754.               begin
  1755.                 DrawFocusRect(Canvas.Handle, where);
  1756.               end;
  1757.             end;
  1758.           end;
  1759.           Inc(curCol);
  1760.           where.Left := where.Left - ColWidths[curCol] - drawInfo.Horz.EffectiveLineWidth;
  1761.           where.Right := where.Left + ColWidths[curCol];
  1762.         end;
  1763.         where.Top := where.Bottom + drawInfo.Vert.EffectiveLineWidth;
  1764.         Inc(curRow);
  1765.       end;
  1766.     end
  1767.     else
  1768. {$ENDIF}
  1769.     begin
  1770.       // Left-aligned grid
  1771.  
  1772.       curRow := aRow;
  1773.       where.Top := startY;
  1774.       while (where.Top < stopY) and (curRow < rowCount) do
  1775.       begin
  1776.         curCol := aCol;
  1777.         where.Left := StartX;
  1778.         where.Bottom := where.Top + RowHeights[CurRow];
  1779.  
  1780.         while (where.Left < stopX) and (curCol < colCount) do
  1781.         begin
  1782.           where.Right := where.Left + ColWidths[CurCol];
  1783.           if RectVisible(Canvas.Handle, Where) then
  1784.           begin
  1785.             DrawState := IncludeDrawState;
  1786.             Focused := IsActiveControl;
  1787.             if Focused and (CurRow = Row) and (CurCol = Col)  then
  1788.               Include(DrawState, gdFocused);
  1789.             if PointInGridRect(CurCol, CurRow, Sel) then
  1790.               Include(DrawState, gdSelected);
  1791.  
  1792.             if not (gdFocused in DrawState) or not (goEditing in Options) or
  1793.               not FEditorMode or (csDesigning in ComponentState) then
  1794.             begin
  1795.               if DefaultDrawing or (csDesigning in ComponentState) then
  1796.               begin
  1797.                 with Canvas do
  1798.                 begin
  1799.                   Font := Self.Font;
  1800.                   if (gdSelected in DrawState) and
  1801.                     (not (gdFocused in DrawState) or
  1802.                     ([goDrawFocusSelected, goRowSelect] * Options <> [])) then
  1803.                   begin
  1804.                     Brush.Color := clHighlight;
  1805.                     Font.Color := clHighlightText;
  1806.                   end
  1807.                   else
  1808.                     Brush.Color := Color;
  1809.                   FillRect(where);
  1810.                 end;
  1811.               end;
  1812.  
  1813.               DrawCell(curCol, curRow, where, drawState);
  1814.  
  1815.               if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
  1816.                 ((FrameFlags1 or FrameFlags2) <> 0) then
  1817.               begin
  1818.                 tempRect := where;
  1819.                 if (FrameFlags1 and BF_RIGHT) = 0 then
  1820.                   Inc(tempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
  1821.                 else if (FrameFlags1 and BF_BOTTOM) = 0 then
  1822.                   Inc(tempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
  1823.                 DrawEdge(Canvas.Handle, tempRect, BDR_RAISEDINNER, FrameFlags1);
  1824.                 DrawEdge(Canvas.Handle, tempRect, BDR_RAISEDINNER, FrameFlags2);
  1825.               end;
  1826.  
  1827.               if DefaultDrawing and not (csDesigning in ComponentState) and
  1828.                 (gdFocused in DrawState) and
  1829.                 ([goEditing, goAlwaysShowEditor]*Options <> [goEditing, goAlwaysShowEditor]) and
  1830.                 not (goRowSelect in Options) then
  1831.               begin
  1832.                 DrawFocusRect(Canvas.Handle, where);
  1833.               end;
  1834.             end;
  1835.           end;
  1836.           where.Left := where.Right + drawInfo.Horz.EffectiveLineWidth;
  1837.           Inc(curCol);
  1838.         end;
  1839.         where.Top := where.Bottom + drawInfo.Vert.EffectiveLineWidth;
  1840.         Inc(curRow);
  1841.       end;
  1842.     end;
  1843.   end;
  1844.  
  1845. begin
  1846.   UpdateRect := Canvas.ClipRect;
  1847.   CalcDrawInfo(DrawInfo);
  1848.  
  1849.   if (drawInfo.Horz.EffectiveLineWidth > 0) or (drawInfo.Vert.EffectiveLineWidth > 0) then
  1850.   begin
  1851.     { Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
  1852.       (fixed, variable) and (variable, variable) }
  1853.  
  1854.     LineColor := clSilver;
  1855.     MaxStroke := IMax(drawInfo.Horz.LastFullVisibleCell - LeftCol + FixedCols,
  1856.                       drawInfo.Vert.LastFullVisibleCell - TopRow + FixedRows) + 3;
  1857.     PointsList := StackAlloc(MaxStroke * sizeof(TPoint) * 2);
  1858.     StrokeList := StackAlloc(MaxStroke * sizeof(Integer));
  1859.     FillDWord(StrokeList^, MaxStroke, 2);
  1860.  
  1861.     if ColorToRGB(Color) = clSilver then
  1862.       LineColor := clGray;
  1863.     DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1864.       0, 0, [0, 0, drawInfo.Horz.FixedBoundary, drawInfo.Vert.FixedBoundary], clBlack, FixedColor);
  1865.     DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1866.       LeftCol, 0, [drawInfo.Horz.FixedBoundary, 0, drawInfo.Horz.GridBoundary,
  1867.       drawInfo.Vert.FixedBoundary], clBlack, FixedColor);
  1868.     DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
  1869.       0, TopRow, [0, drawInfo.Vert.FixedBoundary, drawInfo.Horz.FixedBoundary,
  1870.       drawInfo.Vert.GridBoundary], clBlack, FixedColor);
  1871.     DrawLines(goHorzLine in Options, goVertLine in Options, LeftCol,
  1872.       TopRow, [drawInfo.Horz.FixedBoundary, drawInfo.Vert.FixedBoundary, drawInfo.Horz.GridBoundary,
  1873.       drawInfo.Vert.GridBoundary], LineColor, Color);
  1874.  
  1875.     StackFree(StrokeList);
  1876.     StackFree(PointsList);
  1877.   end;
  1878.  
  1879.   { Draw the cells in the four areas }
  1880.   Sel := Selection;
  1881.   FrameFlags1 := 0;
  1882.   FrameFlags2 := 0;
  1883.   if goFixedVertLine in Options then
  1884.   begin
  1885.     FrameFlags1 := BF_RIGHT;
  1886.     FrameFlags2 := BF_LEFT;
  1887.   end;
  1888.   if goFixedHorzLine in Options then
  1889.   begin
  1890.     FrameFlags1 := FrameFlags1 or BF_BOTTOM;
  1891.     FrameFlags2 := FrameFlags2 or BF_TOP;
  1892.   end;
  1893.   DrawCells(0, 0, 0, 0, drawInfo.Horz.FixedBoundary, drawInfo.Vert.FixedBoundary, FixedColor,
  1894.     [gdFixed]);
  1895.   DrawCells(LeftCol, 0, drawInfo.Horz.FixedBoundary - FColOffset, 0, drawInfo.Horz.GridBoundary,  //!! clip
  1896.     drawInfo.Vert.FixedBoundary, FixedColor, [gdFixed]);
  1897.   DrawCells(0, TopRow, 0, drawInfo.Vert.FixedBoundary, drawInfo.Horz.FixedBoundary,
  1898.     drawInfo.Vert.GridBoundary, FixedColor, [gdFixed]);
  1899.   DrawCells(LeftCol, TopRow, drawInfo.Horz.FixedBoundary - FColOffset,                   //!! clip
  1900.     drawInfo.Vert.FixedBoundary, drawInfo.Horz.GridBoundary, drawInfo.Vert.GridBoundary, Color, []);
  1901.  
  1902.   if not (csDesigning in ComponentState) and
  1903.     (goRowSelect in Options) and DefaultDrawing and Focused then
  1904.   begin
  1905.     GridRectToScreenRect(GetSelection, FocRect, False);
  1906.     Canvas.DrawFocusRect(FocRect);
  1907.   end;
  1908.  
  1909.   { Fill in area not occupied by cells }
  1910.   if drawInfo.Horz.GridBoundary < drawInfo.Horz.GridExtent then
  1911.   begin
  1912.     Canvas.Brush.Color := Color;
  1913. {$IFDEF IVPRO32}
  1914.     if IvIsLocaleBidirectional(FLocale) then
  1915.       Canvas.FillRect(Rect(ClientWidth - drawInfo.Horz.GridBoundary, 0, ClientWidth - drawInfo.Horz.GridExtent, drawInfo.Vert.GridBoundary))
  1916.     else
  1917. {$ENDIF}
  1918.       Canvas.FillRect(Rect(drawInfo.Horz.GridBoundary, 0, drawInfo.Horz.GridExtent, drawInfo.Vert.GridBoundary));
  1919.   end;
  1920.   if drawInfo.Vert.GridBoundary < drawInfo.Vert.GridExtent then
  1921.   begin
  1922.     Canvas.Brush.Color := Color;
  1923.     Canvas.FillRect(Rect(0, drawInfo.Vert.GridBoundary, drawInfo.Horz.GridExtent, drawInfo.Vert.GridExtent));
  1924.   end;
  1925. end;
  1926.  
  1927. function TIvCustomGrid.CalcCoordFromPoint(
  1928.   x, y: Integer;
  1929.   const drawInfo: TIvGridDrawInfo): TIvGridCoord;
  1930.  
  1931.   function DoCalc(const axisInfo: TIvGridAxisDrawInfo; n: Integer): Integer;
  1932.   var
  1933.     i, start, stop: Longint;
  1934.     line: Integer;
  1935.   begin
  1936. {$IFDEF IVPRO32}
  1937.     if IvIsLocaleBidirectional(FLocale) and (axisInfo.AxisType = gaHorizontal) then
  1938.     begin
  1939.       if n > ClientWidth - axisInfo.FixedBoundary then
  1940.       begin
  1941.         start := 0;
  1942.         stop := axisInfo.FixedCellCount - 1;
  1943.         line := 0;
  1944.       end
  1945.       else
  1946.       begin
  1947.         start := axisInfo.FirstGridCell;
  1948.         stop := axisInfo.GridCellCount - 1;
  1949.         line := ClientWidth - axisInfo.FixedBoundary;
  1950.       end;
  1951.  
  1952.       Result := -1;
  1953.       for i := Start to Stop do
  1954.       begin
  1955.         Dec(Line, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  1956.         if n > line then
  1957.         begin
  1958.           Result := i;
  1959.           Exit;
  1960.         end;
  1961.       end;
  1962.     end
  1963.     else
  1964. {$ENDIF}
  1965.     begin
  1966.       if n < axisInfo.FixedBoundary then
  1967.       begin
  1968.         Start := 0;
  1969.         Stop := axisInfo.FixedCellCount - 1;
  1970.         Line := 0;
  1971.       end
  1972.       else
  1973.       begin
  1974.         Start := axisInfo.FirstGridCell;
  1975.         Stop := axisInfo.GridCellCount - 1;
  1976.         Line := axisInfo.FixedBoundary;
  1977.       end;
  1978.  
  1979.       Result := -1;
  1980.       for i := Start to Stop do
  1981.       begin
  1982.         Inc(line, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  1983.         if n < line then
  1984.         begin
  1985.           Result := i;
  1986.           Exit;
  1987.         end;
  1988.       end;
  1989.     end;
  1990.   end;
  1991.  
  1992. begin
  1993.   Result.X := DoCalc(drawInfo.Horz, x);
  1994.   Result.Y := DoCalc(drawInfo.Vert, y);
  1995. end;
  1996.  
  1997. procedure TIvCustomGrid.CalcDrawInfo(var DrawInfo: TIvGridDrawInfo);
  1998. begin
  1999.   CalcDrawInfoXY(DrawInfo, ClientWidth, ClientHeight);
  2000. end;
  2001.  
  2002. procedure TIvCustomGrid.CalcDrawInfoXY(
  2003.   var drawInfo: TIvGridDrawInfo;
  2004.   useWidth, useHeight: Integer);
  2005.  
  2006.   procedure CalcAxis(var axisInfo: TIvGridAxisDrawInfo; useExtent: Integer);
  2007.   var
  2008.     i: Integer;
  2009.   begin
  2010.     axisInfo.GridExtent := useExtent;
  2011.     axisInfo.GridBoundary := axisInfo.FixedBoundary;
  2012.     axisInfo.FullVisBoundary := axisInfo.FixedBoundary;
  2013.     axisInfo.LastFullVisibleCell := axisInfo.FirstGridCell;
  2014.     for i := axisInfo.FirstGridCell to axisInfo.GridCellCount - 1 do
  2015.     begin
  2016.       Inc(axisInfo.GridBoundary, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  2017.       if axisInfo.GridBoundary > axisInfo.GridExtent + axisInfo.EffectiveLineWidth then
  2018.       begin
  2019.         axisInfo.GridBoundary := axisInfo.GridExtent;
  2020.         Break;
  2021.       end;
  2022.       axisInfo.LastFullVisibleCell := i;
  2023.       axisInfo.FullVisBoundary := axisInfo.GridBoundary;
  2024.     end;
  2025.   end;
  2026.  
  2027. begin
  2028.   drawInfo.Horz.AxisType := gaHorizontal;
  2029.   drawInfo.Vert.AxisType := gaVertical;
  2030.   CalcFixedInfo(drawInfo);
  2031.   CalcAxis(drawInfo.Horz, useWidth);
  2032.   CalcAxis(drawInfo.Vert, useHeight);
  2033. end;
  2034.  
  2035. procedure TIvCustomGrid.CalcFixedInfo(var drawInfo: TIvGridDrawInfo);
  2036.  
  2037.   procedure CalcFixedAxis(
  2038.     var axis: TIvGridAxisDrawInfo;
  2039.     lineOptions: TIvGridOptions;
  2040.     fixedCount, firstCell, cellCount: Integer;
  2041.     getExtentFunc: TIvGetExtentsFunc);
  2042.   var
  2043.     i: Integer;
  2044.   begin
  2045.     if lineOptions*options = [] then
  2046.       axis.EffectiveLineWidth := 0
  2047.     else
  2048.       axis.EffectiveLineWidth := GridLineWidth;
  2049.       
  2050.     axis.FixedBoundary := 0;
  2051.     for i := 0 to fixedCount - 1 do
  2052.       Inc(axis.FixedBoundary, GetExtentFunc(i) + axis.EffectiveLineWidth);
  2053.  
  2054.     axis.FixedCellCount := fixedCount;
  2055.     axis.FirstGridCell := firstCell;
  2056.     axis.GridCellCount := cellCount;
  2057.     axis.GetExtent := getExtentFunc;
  2058.   end;
  2059.  
  2060. begin
  2061.   CalcFixedAxis(
  2062.     drawInfo.Horz,
  2063.     [goFixedVertLine, goVertLine],
  2064.     fixedCols,
  2065.     leftCol,
  2066.     colCount,
  2067.     getColWidths);
  2068.   CalcFixedAxis(
  2069.     drawInfo.Vert,
  2070.     [goFixedHorzLine, goHorzLine],
  2071.     fixedRows,
  2072.     topRow,
  2073.     rowCount,
  2074.     getRowHeights);
  2075. end;
  2076.  
  2077. { Calculates the TopLeft that will put the given Coord in view }
  2078. function TIvCustomGrid.CalcMaxTopLeft(const Coord: TIvGridCoord;
  2079.   const DrawInfo: TIvGridDrawInfo): TIvGridCoord;
  2080.  
  2081.   function CalcMaxCell(const Axis: TIvGridAxisDrawInfo; Start: Integer): Integer;
  2082.   var
  2083.     Line: Integer;
  2084.     I: Longint;
  2085.   begin
  2086.     Result := Start;
  2087.     with Axis do
  2088.     begin
  2089.       Line := GridExtent + EffectiveLineWidth;
  2090.       for I := Start downto FixedCellCount do
  2091.       begin
  2092.         Dec(Line, GetExtent(I));
  2093.         Dec(Line, EffectiveLineWidth);
  2094.         if Line < FixedBoundary then Break;
  2095.         Result := I;
  2096.       end;
  2097.     end;
  2098.   end;
  2099.  
  2100. begin
  2101.   Result.X := CalcMaxCell(DrawInfo.Horz, Coord.X);
  2102.   Result.Y := CalcMaxCell(DrawInfo.Vert, Coord.Y);
  2103. end;
  2104.  
  2105. procedure TIvCustomGrid.CalcSizingState(
  2106.   x, y: Integer;
  2107.   var state: TIvGridState;
  2108.   var index: Longint;
  2109.   var sizingPos, sizingOfs: Integer;
  2110.   var fixedInfo: TIvGridDrawInfo);
  2111.  
  2112.   procedure CalcAxisState(
  2113.     const axisInfo: TIvGridAxisDrawInfo;
  2114.     pos: Integer;
  2115.     newState: TIvGridState);
  2116.   var
  2117.     i, line, back, range: Integer;
  2118.   begin
  2119. {$IFDEF IVPRO32}
  2120.     if IvIsLocaleBidirectional(FLocale) and (axisInfo.AxisType = gaHorizontal) then
  2121.       line := ClientWidth - axisInfo.FixedBoundary
  2122.     else
  2123. {$ENDIF}
  2124.       line := axisInfo.FixedBoundary;
  2125.  
  2126.     range := axisInfo.EffectiveLineWidth;
  2127.     back := 0;
  2128.     if range < 7 then
  2129.     begin
  2130.       range := 7;
  2131.       back := (range - axisInfo.EffectiveLineWidth) shr 1;
  2132.     end;
  2133.  
  2134.     for i := axisInfo.FirstGridCell to axisInfo.GridCellCount - 1 do
  2135.     begin
  2136. {$IFDEF IVPRO32}
  2137.       if IvIsLocaleBidirectional(FLocale) and (axisInfo.AxisType = gaHorizontal) then
  2138.         Dec(line, axisInfo.GetExtent(I))
  2139.       else
  2140. {$ENDIF}
  2141.         Inc(line, axisInfo.GetExtent(I));
  2142.  
  2143.       // If line is out of grid breaks
  2144.  
  2145. {$IFDEF IVPRO32}
  2146.       if IvIsLocaleBidirectional(FLocale) and (axisInfo.AxisType = gaHorizontal) then
  2147.       begin
  2148.         if line < ClientWidth - axisInfo.GridBoundary then
  2149.           Break;
  2150.       end
  2151.       else
  2152. {$ENDIF}
  2153.       begin
  2154.         if line > axisInfo.GridBoundary then
  2155.           Break;
  2156.       end;
  2157.  
  2158.       if (pos >= line - back) and (pos <= line - back + range) then
  2159.       begin
  2160.         state := newState;
  2161.         sizingPos := line;
  2162.         sizingOfs := line - pos;
  2163.         index := i;
  2164.         Exit;
  2165.       end;
  2166.  
  2167. {$IFDEF IVPRO32}
  2168.       if IvIsLocaleBidirectional(FLocale) and (axisInfo.AxisType = gaHorizontal) then
  2169.         Dec(line, axisInfo.EffectiveLineWidth)
  2170.       else
  2171. {$ENDIF}
  2172.         Inc(line, axisInfo.EffectiveLineWidth);
  2173.     end;
  2174.  
  2175.     if (axisInfo.GridBoundary = axisInfo.GridExtent) and
  2176.       (pos >= axisInfo.GridExtent - back) and
  2177.       (pos <= axisInfo.GridExtent) then
  2178.     begin
  2179.       state := newState;
  2180.       sizingPos := axisInfo.GridExtent;
  2181.       sizingOfs := axisInfo.GridExtent - pos;
  2182.       index := axisInfo.LastFullVisibleCell + 1;
  2183.     end;
  2184.   end;
  2185.  
  2186. var
  2187.   effectiveOptions: TIvGridOptions;
  2188. begin
  2189.   state := gsNormal;
  2190.   index := -1;
  2191.   effectiveOptions := Options;
  2192.   if csDesigning in ComponentState then
  2193.     effectiveOptions := effectiveOptions + DesignOptionsBoost;
  2194.  
  2195.   if [goColSizing, goRowSizing]*effectiveOptions <> [] then
  2196.   begin
  2197.     fixedInfo.Vert.GridExtent := ClientHeight;
  2198.     fixedInfo.Horz.GridExtent := ClientWidth;
  2199. {$IFDEF IVPRO32}
  2200.     if IvIsLocaleBidirectional(FLocale) then
  2201.     begin
  2202.       if (x < ClientWidth - fixedInfo.Horz.FixedBoundary) and (goColSizing in effectiveOptions) then
  2203.       begin
  2204.         if y >= fixedInfo.Vert.FixedBoundary then
  2205.           Exit;
  2206.         CalcAxisState(fixedInfo.Horz, x, gsColSizing);
  2207.       end
  2208.       else if (y > fixedInfo.Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
  2209.       begin
  2210.         if x < ClientWidth - fixedInfo.Horz.FixedBoundary then
  2211.           Exit;
  2212.         CalcAxisState(fixedInfo.Vert, Y, gsRowSizing);
  2213.       end;
  2214.     end
  2215.     else
  2216. {$ENDIF}
  2217.     begin
  2218.       if (x > fixedInfo.Horz.FixedBoundary) and (goColSizing in effectiveOptions) then
  2219.       begin
  2220.         if y >= fixedInfo.Vert.FixedBoundary then
  2221.           Exit;
  2222.         CalcAxisState(fixedInfo.Horz, x, gsColSizing);
  2223.       end
  2224.       else if (y > fixedInfo.Vert.FixedBoundary) and (goRowSizing in EffectiveOptions) then
  2225.       begin
  2226.         if x >= fixedInfo.Horz.FixedBoundary then
  2227.           Exit;
  2228.         CalcAxisState(fixedInfo.Vert, Y, gsRowSizing);
  2229.       end;
  2230.     end;
  2231.   end;
  2232. end;
  2233.  
  2234. procedure TIvCustomGrid.ChangeSize(NewColCount, NewRowCount: Longint);
  2235. var
  2236.   OldColCount, OldRowCount: Longint;
  2237.   OldDrawInfo: TIvGridDrawInfo;
  2238.  
  2239.   procedure MinRedraw(const OldInfo, NewInfo: TIvGridAxisDrawInfo; Axis: Integer);
  2240.   var
  2241.     R: TRect;
  2242.     First: Integer;
  2243.   begin
  2244.     if (OldInfo.LastFullVisibleCell = NewInfo.LastFullVisibleCell) then Exit;
  2245.     First := IMin(OldInfo.LastFullVisibleCell, NewInfo.LastFullVisibleCell);
  2246.     // Get the rectangle around the leftmost or topmost cell in the target range.
  2247.     R := CellRect(First and not Axis, First and Axis);
  2248.     R.Bottom := Height;
  2249.     R.Right := Width;
  2250.     Windows.InvalidateRect(Handle, @R, False);
  2251.   end;
  2252.  
  2253.   procedure DoChange;
  2254.   var
  2255.     Coord: TIvGridCoord;
  2256.     NewDrawInfo: TIvGridDrawInfo;
  2257.   begin
  2258.     if FColWidths <> nil then
  2259.     begin
  2260.       UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  2261.       UpdateExtents(FTabStops, ColCount, Integer(True));
  2262.     end;
  2263.  
  2264.     if FRowHeights <> nil then
  2265.       UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  2266.  
  2267.     Coord := FCurrent;
  2268.     if Row >= RowCount then
  2269.       Coord.Y := RowCount - 1;
  2270.     if Col >= ColCount then
  2271.       Coord.X := ColCount - 1;
  2272.     if (FCurrent.X <> Coord.X) or (FCurrent.Y <> Coord.Y) then
  2273.       MoveCurrent(Coord.X, Coord.Y, True, True);
  2274.     if (FAnchor.X <> Coord.X) or (FAnchor.Y <> Coord.Y) then
  2275.       MoveAnchor(Coord);
  2276.     if VirtualView or
  2277.       (LeftCol <> OldDrawInfo.Horz.FirstGridCell) or
  2278.       (TopRow <> OldDrawInfo.Vert.FirstGridCell) then
  2279.       InvalidateGrid
  2280.     else if HandleAllocated then
  2281.     begin
  2282.       CalcDrawInfo(NewDrawInfo);
  2283.       MinRedraw(OldDrawInfo.Horz, NewDrawInfo.Horz, 0);
  2284.       MinRedraw(OldDrawInfo.Vert, NewDrawInfo.Vert, -1);
  2285.     end;
  2286.     while FColLocale.Count < FColCount do
  2287.       FColLocale.Add(Pointer(0));
  2288.     UpdateScrollRange;
  2289.     SizeChanged(OldColCount, OldRowCount);
  2290.   end;
  2291.  
  2292. begin
  2293.   if HandleAllocated then
  2294.     CalcDrawInfo(OldDrawInfo);
  2295.   OldColCount := FColCount;
  2296.   OldRowCount := FRowCount;
  2297.   FColCount := NewColCount;
  2298.   FRowCount := NewRowCount;
  2299.   if FixedCols > NewColCount then FFixedCols := NewColCount - 1;
  2300.   if FixedRows > NewRowCount then FFixedRows := NewRowCount - 1;
  2301.   try
  2302.     DoChange;
  2303.   except
  2304.     { Could not change size so try to clean up by setting the size back }
  2305.     FColCount := OldColCount;
  2306.     FRowCount := OldRowCount;
  2307.     DoChange;
  2308.     InvalidateGrid;
  2309.     raise;
  2310.   end;
  2311. end;
  2312.  
  2313. { Will move TopLeft so that Coord is in view }
  2314. procedure TIvCustomGrid.ClampInView(const Coord: TIvGridCoord);
  2315. var
  2316.   DrawInfo: TIvGridDrawInfo;
  2317.   MaxTopLeft: TIvGridCoord;
  2318.   OldTopLeft: TIvGridCoord;
  2319. begin
  2320.   if not HandleAllocated then Exit;
  2321.   CalcDrawInfo(DrawInfo);
  2322.   with DrawInfo, Coord do
  2323.   begin
  2324.     if (X > Horz.LastFullVisibleCell) or
  2325.       (Y > Vert.LastFullVisibleCell) or (X < LeftCol) or (Y < TopRow) then
  2326.     begin
  2327.       OldTopLeft := FTopLeft;
  2328.       MaxTopLeft := CalcMaxTopLeft(Coord, DrawInfo);
  2329.       Update;
  2330.       if X < LeftCol then FTopLeft.X := X
  2331.       else if X > Horz.LastFullVisibleCell then FTopLeft.X := MaxTopLeft.X;
  2332.       if Y < TopRow then FTopLeft.Y := Y
  2333.       else if Y > Vert.LastFullVisibleCell then FTopLeft.Y := MaxTopLeft.Y;
  2334.       TopLeftMoved(OldTopLeft);
  2335.     end;
  2336.   end;
  2337. end;
  2338.  
  2339. procedure TIvCustomGrid.DrawSizingLine(const DrawInfo: TIvGridDrawInfo);
  2340. var
  2341.   OldPen: TPen;
  2342. begin
  2343.   OldPen := TPen.Create;
  2344.   try
  2345.     with Canvas, DrawInfo do
  2346.     begin
  2347.       OldPen.Assign(Pen);
  2348.       Pen.Style := psDot;
  2349.       Pen.Mode := pmXor;
  2350.       Pen.Width := 1;
  2351.       try
  2352.         if FGridState = gsRowSizing then
  2353.         begin
  2354. {$IFDEF IVPRO32}
  2355.           if IvIsLocaleBidirectional(FLocale) then
  2356.           begin
  2357.             MoveTo(ClientWidth - Horz.GridBoundary, FSizingPos);
  2358.             LineTo(ClientWidth, FSizingPos);
  2359.           end
  2360.           else
  2361. {$ENDIF}
  2362.           begin
  2363.             MoveTo(0, FSizingPos);
  2364.             LineTo(Horz.GridBoundary, FSizingPos);
  2365.           end;
  2366.         end
  2367.         else
  2368.         begin
  2369.           MoveTo(FSizingPos, 0);
  2370.           LineTo(FSizingPos, Vert.GridBoundary);
  2371.         end;
  2372.       finally
  2373.         Pen := OldPen;
  2374.       end;
  2375.     end;
  2376.   finally
  2377.     OldPen.Free;
  2378.   end;
  2379. end;
  2380.  
  2381. procedure TIvCustomGrid.DrawMove;
  2382. var
  2383.   OldPen: TPen;
  2384.   Pos: Integer;
  2385.   R: TRect;
  2386. begin
  2387.   OldPen := TPen.Create;
  2388.   try
  2389.     with Canvas do
  2390.     begin
  2391.       OldPen.Assign(Pen);
  2392.       try
  2393.         Pen.Style := psDot;
  2394.         Pen.Mode := pmXor;
  2395.         Pen.Width := 5;
  2396.         if FGridState = gsRowMoving then
  2397.         begin
  2398.           R := CellRect(0, FMovePos);
  2399.           if FMovePos > FMoveIndex then
  2400.             Pos := R.Bottom else
  2401.             Pos := R.Top;
  2402.           MoveTo(0, Pos);
  2403.           LineTo(ClientWidth, Pos);
  2404.         end
  2405.         else
  2406.         begin
  2407.           R := CellRect(FMovePos, 0);
  2408.           if FMovePos > FMoveIndex then
  2409.             Pos := R.Right else
  2410.             Pos := R.Left;
  2411.           MoveTo(Pos, 0);
  2412.           LineTo(Pos, ClientHeight);
  2413.         end;
  2414.       finally
  2415.         Canvas.Pen := OldPen;
  2416.       end;
  2417.     end;
  2418.   finally
  2419.     OldPen.Free;
  2420.   end;
  2421. end;
  2422.  
  2423. procedure TIvCustomGrid.FocusCell(ACol, ARow: Longint; MoveAnchor: Boolean);
  2424. begin
  2425.   MoveCurrent(ACol, ARow, MoveAnchor, True);
  2426.   UpdateEdit;
  2427.   Click;
  2428. end;
  2429.  
  2430. procedure TIvCustomGrid.GridRectToScreenRect(
  2431.   gridRect: TIvGridRect;
  2432.   var screenRect: TRect;
  2433.   includeLine: Boolean);
  2434.  
  2435.   function LinePos(const axisInfo: TIvGridAxisDrawInfo; line: Integer): Integer;
  2436.   var
  2437.     start, i: Longint;
  2438.   begin
  2439.     Result := 0;
  2440.     if line < axisInfo.FixedCellCount then
  2441.       Start := 0
  2442.     else
  2443.     begin
  2444.       if Line >= axisInfo.FirstGridCell then
  2445.         Result := axisInfo.FixedBoundary;
  2446.       Start := axisInfo.FirstGridCell;
  2447.     end;
  2448.  
  2449.     for I := Start to Line - 1 do
  2450.     begin
  2451.       Inc(Result, axisInfo.GetExtent(I) + axisInfo.EffectiveLineWidth);
  2452.       if Result > axisInfo.GridExtent then
  2453.       begin
  2454.         Result := 0;
  2455.         Exit;
  2456.       end;
  2457.     end;
  2458.   end;
  2459.  
  2460.   function CalcAxis(
  2461.     const axisInfo: TIvGridAxisDrawInfo;
  2462.     gridRectMin, gridRectMax: Integer;
  2463.     var screenRectMin, screenRectMax: Integer): Boolean;
  2464.   begin
  2465.     Result := False;
  2466.     if (GridRectMin >= axisInfo.FixedCellCount) and (GridRectMin < axisInfo.FirstGridCell) then
  2467.     begin
  2468.       if GridRectMax < axisInfo.FirstGridCell then
  2469.       begin
  2470.         FillChar(ScreenRect, SizeOf(ScreenRect), 0); { erase partial results }
  2471.         Exit;
  2472.       end
  2473.       else
  2474.         GridRectMin := axisInfo.FirstGridCell;
  2475.     end;
  2476.  
  2477.     if GridRectMax > axisInfo.LastFullVisibleCell then
  2478.     begin
  2479.       GridRectMax := axisInfo.LastFullVisibleCell;
  2480.       if GridRectMax < axisInfo.GridCellCount - 1 then
  2481.         Inc(GridRectMax);
  2482.       if LinePos(AxisInfo, GridRectMax) = 0 then
  2483.         Dec(GridRectMax);
  2484.     end;
  2485.  
  2486.     screenRectMin := LinePos(AxisInfo, GridRectMin);
  2487.     screenRectMax := LinePos(AxisInfo, GridRectMax);
  2488.     if screenRectMax = 0 then
  2489.       screenRectMax := screenRectMin + axisInfo.GetExtent(GridRectMin)
  2490.     else
  2491.       Inc(screenRectMax, axisInfo.GetExtent(GridRectMax));
  2492.  
  2493.     if screenRectMax > axisInfo.GridExtent then
  2494.       screenRectMax := axisInfo.GridExtent;
  2495.  
  2496.     if IncludeLine then
  2497.       Inc(screenRectMax, axisInfo.EffectiveLineWidth);
  2498.  
  2499.     Result := True;
  2500.   end;
  2501.  
  2502. var
  2503. {$IFDEF IVPRO32}
  2504.   rect: TRect;
  2505. {$ENDIF}
  2506.   drawInfo: TIvGridDrawInfo;
  2507. begin
  2508.   FillChar(screenRect, SizeOf(screenRect), 0);
  2509.   if (gridRect.Left > gridRect.Right) or (gridRect.Top > gridRect.Bottom) then
  2510.     Exit;
  2511.   CalcDrawInfo(drawInfo);
  2512.  
  2513.   if gridRect.Left > drawInfo.Horz.LastFullVisibleCell + 1 then
  2514.     Exit;
  2515.   if gridRect.Top > drawInfo.Vert.LastFullVisibleCell + 1 then
  2516.     Exit;
  2517.  
  2518.   if CalcAxis(drawInfo.Horz, gridRect.Left, gridRect.Right, screenRect.Left, screenRect.Right) then
  2519.   begin
  2520.     CalcAxis(
  2521.       drawInfo.Vert,
  2522.       gridRect.Top,
  2523.       gridRect.Bottom,
  2524.       screenRect.Top,
  2525.       screenRect.Bottom);
  2526.   end;
  2527.  
  2528. {$IFDEF IVPRO32}
  2529.   if IvIsLocaleBidirectional(FLocale) then
  2530.   begin
  2531.     rect := screenRect;
  2532.     rect.Left := ClientWidth - screenRect.Left;
  2533.     rect.Right := ClientWidth - screenRect.Right;
  2534.     screenRect.Left := rect.Right;
  2535.     screenRect.Right := rect.Left;
  2536.   end;
  2537. {$ENDIF}
  2538. end;
  2539.  
  2540. procedure TIvCustomGrid.Initialize;
  2541. begin
  2542.   FTopLeft.X := FixedCols;
  2543.   FTopLeft.Y := FixedRows;
  2544.   FCurrent := FTopLeft;
  2545.   FAnchor := FCurrent;
  2546.   if goRowSelect in Options then
  2547.     FAnchor.X := ColCount - 1;
  2548. end;
  2549.  
  2550. procedure TIvCustomGrid.InvalidateCell(ACol, ARow: Longint);
  2551. var
  2552.   Rect: TIvGridRect;
  2553. begin
  2554.   Rect.Top := ARow;
  2555.   Rect.Left := ACol;
  2556.   Rect.Bottom := ARow;
  2557.   Rect.Right := ACol;
  2558.   InvalidateRect(Rect);
  2559. end;
  2560.  
  2561. procedure TIvCustomGrid.InvalidateCol(ACol: Longint);
  2562. var
  2563.   Rect: TIvGridRect;
  2564. begin
  2565.   if not HandleAllocated then Exit;
  2566.   Rect.Top := 0;
  2567.   Rect.Left := ACol;
  2568.   Rect.Bottom := VisibleRowCount+1;
  2569.   Rect.Right := ACol;
  2570.   InvalidateRect(Rect);
  2571. end;
  2572.  
  2573. procedure TIvCustomGrid.InvalidateRow(ARow: Longint);
  2574. var
  2575.   Rect: TIvGridRect;
  2576. begin
  2577.   if not HandleAllocated then Exit;
  2578.   Rect.Top := ARow;
  2579.   Rect.Left := 0;
  2580.   Rect.Bottom := ARow;
  2581.   Rect.Right := VisibleColCount+1;
  2582.   InvalidateRect(Rect);
  2583. end;
  2584.  
  2585. procedure TIvCustomGrid.InvalidateGrid;
  2586. begin
  2587.   Invalidate;
  2588. end;
  2589.  
  2590. procedure TIvCustomGrid.InvalidateRect(ARect: TIvGridRect);
  2591. var
  2592.   InvalidRect: TRect;
  2593. begin
  2594.   if not HandleAllocated then Exit;
  2595.   GridRectToScreenRect(ARect, InvalidRect, True);
  2596.   Windows.InvalidateRect(Handle, @InvalidRect, False);
  2597. end;
  2598.  
  2599. procedure TIvCustomGrid.ModifyScrollBar(ScrollBar, ScrollCode, Pos: Cardinal);
  2600. var
  2601.   NewTopLeft, MaxTopLeft: TIvGridCoord;
  2602.   DrawInfo: TIvGridDrawInfo;
  2603.  
  2604.   function Min: Longint;
  2605.   begin
  2606.     if ScrollBar = SB_HORZ then
  2607.       Result := FixedCols
  2608.     else
  2609.       Result := FixedRows;
  2610.   end;
  2611.  
  2612.   function Max: Longint;
  2613.   begin
  2614.     if ScrollBar = SB_HORZ then
  2615.       Result := MaxTopLeft.X
  2616.     else
  2617.       Result := MaxTopLeft.Y;
  2618.   end;
  2619.  
  2620.   function PageUp: Longint;
  2621.   var
  2622.     MaxTopLeft: TIvGridCoord;
  2623.   begin
  2624.     MaxTopLeft := CalcMaxTopLeft(FTopLeft, DrawInfo);
  2625.     if ScrollBar = SB_HORZ then
  2626.       Result := FTopLeft.X - MaxTopLeft.X else
  2627.       Result := FTopLeft.Y - MaxTopLeft.Y;
  2628.     if Result < 1 then Result := 1;
  2629.   end;
  2630.  
  2631.   function PageDown: Longint;
  2632.   var
  2633.     DrawInfo: TIvGridDrawInfo;
  2634.   begin
  2635.     CalcDrawInfo(DrawInfo);
  2636.     with DrawInfo do
  2637.       if ScrollBar = SB_HORZ then
  2638.         Result := Horz.LastFullVisibleCell - FTopLeft.X else
  2639.         Result := Vert.LastFullVisibleCell - FTopLeft.Y;
  2640.     if Result < 1 then Result := 1;
  2641.   end;
  2642.  
  2643.   function CalcVerticalScrollBar(Value: Longint): Longint;
  2644.   begin
  2645.     Result := Value;
  2646.     case ScrollCode of
  2647.       SB_LINEUP:
  2648.         Result := Value - 1;
  2649.  
  2650.       SB_LINEDOWN:
  2651.         Result := Value + 1;
  2652.  
  2653.       SB_PAGEUP:
  2654.         Result := Value - PageUp;
  2655.  
  2656.       SB_PAGEDOWN:
  2657.         Result := Value + PageDown;
  2658.  
  2659.       SB_THUMBPOSITION, SB_THUMBTRACK:
  2660.         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
  2661.           Result := Min + LongMulDiv(Pos, Max - Min, IvMaxShortInt);
  2662.  
  2663.       SB_BOTTOM:
  2664.         Result := Min;
  2665.  
  2666.       SB_TOP:
  2667.         Result := Min;
  2668.     end;
  2669.   end;
  2670.  
  2671.   function CalcHorizontalScrollBar(Value: Longint): Longint;
  2672.   begin
  2673.     Result := Value;
  2674.     case ScrollCode of
  2675.       SB_LINEUP:
  2676. {$IFDEF IVPRO32}
  2677.         if IvIsLocaleBidirectional(FLocale) then
  2678.           Result := Value + 1
  2679.         else
  2680. {$ENDIF}
  2681.           Result := Value - 1;
  2682.  
  2683.       SB_LINEDOWN:
  2684. {$IFDEF IVPRO32}
  2685.         if IvIsLocaleBidirectional(FLocale) then
  2686.           Result := Value - 1
  2687.         else
  2688. {$ENDIF}
  2689.           Result := Value + 1;
  2690.  
  2691.       SB_PAGEUP:
  2692. {$IFDEF IVPRO32}
  2693.         if IvIsLocaleBidirectional(FLocale) then
  2694.           Result := Value + PageUp
  2695.         else
  2696. {$ENDIF}
  2697.           Result := Value - PageUp;
  2698.  
  2699.       SB_PAGEDOWN:
  2700. {$IFDEF IVPRO32}
  2701.         if IvIsLocaleBidirectional(FLocale) then
  2702.           Result := Value - PageDown
  2703.         else
  2704. {$ENDIF}
  2705.           Result := Value + PageDown;
  2706.  
  2707.       SB_THUMBPOSITION, SB_THUMBTRACK:
  2708.         if (goThumbTracking in Options) or (ScrollCode = SB_THUMBPOSITION) then
  2709.         begin
  2710. {$IFDEF IVPRO32}
  2711.           if IvIsLocaleBidirectional(FLocale) then
  2712.             Result := MaxTopLeft.X - (LongMulDiv(Pos, Max - Min, IvMaxShortInt))
  2713.           else
  2714. {$ENDIF}
  2715.             Result := Min + LongMulDiv(Pos, Max - Min, IvMaxShortInt);
  2716.         end;
  2717.  
  2718.       SB_BOTTOM:
  2719. {$IFDEF IVPRO32}
  2720.         if IvIsLocaleBidirectional(FLocale) then
  2721.           Result := Max
  2722.         else
  2723. {$ENDIF}
  2724.           Result := Min;
  2725.  
  2726.       SB_TOP:
  2727. {$IFDEF IVPRO32}
  2728.         if IvIsLocaleBidirectional(FLocale) then
  2729.           Result := Max
  2730.         else
  2731. {$ENDIF}
  2732.           Result := Min;
  2733.     end;
  2734.   end;
  2735.  
  2736.   procedure ModifyPixelScrollBar(Code, Pos: Cardinal);
  2737.   var
  2738.     NewOffset: Integer;
  2739.     OldOffset: Integer;
  2740.     R: TIvGridRect;
  2741.     GridSpace, ColWidth: Integer;
  2742.   begin
  2743.     NewOffset := FColOffset;
  2744.     ColWidth := ColWidths[DrawInfo.Horz.FirstGridCell];
  2745.     GridSpace := ClientWidth - DrawInfo.Horz.FixedBoundary;
  2746.     case Code of
  2747.       SB_LINEUP: Dec(NewOffset, Canvas.TextWidth('0'));
  2748.       SB_LINEDOWN: Inc(NewOffset, Canvas.TextWidth('0'));
  2749.       SB_PAGEUP: Dec(NewOffset, GridSpace);
  2750.       SB_PAGEDOWN: Inc(NewOffset, GridSpace);
  2751.       SB_THUMBPOSITION: NewOffset := Pos;
  2752.       SB_THUMBTRACK: if goThumbTracking in Options then NewOffset := Pos;
  2753.       SB_BOTTOM: NewOffset := 0;
  2754.       SB_TOP: NewOffset := ColWidth - GridSpace;
  2755.     end;
  2756.     if NewOffset < 0 then
  2757.       NewOffset := 0
  2758.     else if NewOffset >= ColWidth - GridSpace then
  2759.       NewOffset := ColWidth - GridSpace;
  2760.     if NewOffset <> FColOffset then
  2761.     begin
  2762.       OldOffset := FColOffset;
  2763.       FColOffset := NewOffset;
  2764.       ScrollData(OldOffset - NewOffset, 0);
  2765.       FillChar(R, SizeOf(R), 0);
  2766.       R.Bottom := FixedRows;
  2767.       InvalidateRect(R);
  2768.       Update;
  2769.       UpdateScrollPos;
  2770.     end;
  2771.   end;
  2772.  
  2773. begin
  2774.   if Visible and CanFocus and TabStop and not (csDesigning in ComponentState) then
  2775.     SetFocus;
  2776.   CalcDrawInfo(DrawInfo);
  2777.   if (ScrollBar = SB_HORZ) and (ColCount = 1) then
  2778.   begin
  2779.     ModifyPixelScrollBar(ScrollCode, Pos);
  2780.     Exit;
  2781.   end;
  2782.  
  2783.   MaxTopLeft.X := ColCount - 1;
  2784.   MaxTopLeft.Y := RowCount - 1;
  2785.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  2786.   NewTopLeft := FTopLeft;
  2787.  
  2788.   if ScrollBar = SB_HORZ then
  2789.     NewTopLeft.X := CalcHorizontalScrollBar(NewTopLeft.X)
  2790.   else
  2791.     NewTopLeft.Y := CalcVerticalScrollBar(NewTopLeft.Y);
  2792.  
  2793.   if NewTopLeft.X < FixedCols then
  2794.     NewTopLeft.X := FixedCols
  2795.   else if NewTopLeft.X > MaxTopLeft.X then
  2796.     NewTopLeft.X := MaxTopLeft.X;
  2797.  
  2798.   if NewTopLeft.Y < FixedRows then
  2799.     NewTopLeft.Y := FixedRows
  2800.   else if NewTopLeft.Y > MaxTopLeft.Y then
  2801.     NewTopLeft.Y := MaxTopLeft.Y;
  2802.  
  2803.   if (NewTopLeft.X <> FTopLeft.X) or (NewTopLeft.Y <> FTopLeft.Y) then
  2804.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  2805. end;
  2806.  
  2807. procedure TIvCustomGrid.MoveAdjust(var CellPos: Longint; FromIndex, ToIndex: Longint);
  2808. var
  2809.   Min, Max: Longint;
  2810. begin
  2811.   if CellPos = FromIndex then CellPos := ToIndex
  2812.   else
  2813.   begin
  2814.     Min := FromIndex;
  2815.     Max := ToIndex;
  2816.     if FromIndex > ToIndex then
  2817.     begin
  2818.       Min := ToIndex;
  2819.       Max := FromIndex;
  2820.     end;
  2821.     if (CellPos >= Min) and (CellPos <= Max) then
  2822.       if FromIndex > ToIndex then
  2823.         Inc(CellPos) else
  2824.         Dec(CellPos);
  2825.   end;
  2826. end;
  2827.  
  2828. procedure TIvCustomGrid.MoveAnchor(const NewAnchor: TIvGridCoord);
  2829. var
  2830.   OldSel: TIvGridRect;
  2831. begin
  2832.   if [goRangeSelect, goEditing] * Options = [goRangeSelect] then
  2833.   begin
  2834.     OldSel := Selection;
  2835.     FAnchor := NewAnchor;
  2836.     if goRowSelect in Options then FAnchor.X := ColCount - 1;
  2837.     ClampInView(NewAnchor);
  2838.     SelectionMoved(OldSel);
  2839.   end
  2840.   else
  2841.     MoveCurrent(NewAnchor.X, NewAnchor.Y, True, True);
  2842. end;
  2843.  
  2844. procedure TIvCustomGrid.MoveCurrent(
  2845.   aCol, aRow: Longint;
  2846.   moveAnchor, show: Boolean);
  2847. var
  2848.   oldSel: TIvGridRect;
  2849.   oldCurrent: TIvGridCoord;
  2850. begin
  2851.   if (aCol < 0) or (aRow < 0) or (aCol >= ColCount) or (aRow >= RowCount) then
  2852.     InvalidOp(SIndexOutOfRange);
  2853.  
  2854.   if SelectCell(aCol, aRow) then
  2855.   begin
  2856.     oldSel := Selection;
  2857.     oldCurrent := FCurrent;
  2858.     FCurrent.X := aCol;
  2859.     FCurrent.Y := aRow;
  2860.     if not (goAlwaysShowEditor in Options) then
  2861.       HideEditor;
  2862.     if MoveAnchor or not (goRangeSelect in Options) then
  2863.     begin
  2864.       FAnchor := FCurrent;
  2865.       if goRowSelect in Options then
  2866.         FAnchor.X := ColCount - 1;
  2867.     end;
  2868.     if goRowSelect in Options then
  2869.       FCurrent.X := FixedCols;
  2870.     if Show then
  2871.       ClampInView(FCurrent);
  2872.     SelectionMoved(OldSel);
  2873.     InvalidateCell(oldCurrent.X, oldCurrent.Y);
  2874.     InvalidateCell(aCol, aRow);
  2875.   end;
  2876. end;
  2877.  
  2878. procedure TIvCustomGrid.MoveTopLeft(ALeft, ATop: Longint);
  2879. var
  2880.   OldTopLeft: TIvGridCoord;
  2881. begin
  2882.   if (ALeft = FTopLeft.X) and (ATop = FTopLeft.Y) then Exit;
  2883.   Update;
  2884.   OldTopLeft := FTopLeft;
  2885.   FTopLeft.X := ALeft;
  2886.   FTopLeft.Y := ATop;
  2887.   TopLeftMoved(OldTopLeft);
  2888. end;
  2889.  
  2890. procedure TIvCustomGrid.ResizeCol(Index: Longint; OldSize, NewSize: Integer);
  2891. begin
  2892.   InvalidateGrid;
  2893. end;
  2894.  
  2895. procedure TIvCustomGrid.ResizeRow(Index: Longint; OldSize, NewSize: Integer);
  2896. begin
  2897.   InvalidateGrid;
  2898. end;
  2899.  
  2900. procedure TIvCustomGrid.SelectionMoved(const OldSel: TIvGridRect);
  2901. var
  2902.   OldRect, NewRect: TRect;
  2903.   AXorRects: TXorRects;
  2904.   I: Integer;
  2905. begin
  2906.   if not HandleAllocated then
  2907.     Exit;
  2908.  
  2909.   GridRectToScreenRect(OldSel, OldRect, True);
  2910.   GridRectToScreenRect(Selection, NewRect, True);
  2911.   XorRects(OldRect, NewRect, AXorRects);
  2912.   for I := Low(AXorRects) to High(AXorRects) do
  2913.     Windows.InvalidateRect(Handle, @AXorRects[I], False);
  2914. end;
  2915.  
  2916. procedure TIvCustomGrid.ScrollDataInfo(DX, DY: Integer;
  2917.   var DrawInfo: TIvGridDrawInfo);
  2918. var
  2919.   ScrollArea: TRect;
  2920.   ScrollFlags: Integer;
  2921. begin
  2922.   with DrawInfo do
  2923.   begin
  2924.     ScrollFlags := SW_INVALIDATE;
  2925.     if not DefaultDrawing then
  2926.       ScrollFlags := ScrollFlags or SW_ERASE;
  2927.     { Scroll the area }
  2928.     if DY = 0 then
  2929.     begin
  2930.       { Scroll both the column titles and data area at the same time }
  2931. {$IFDEF IVPRO32}
  2932.       if IvIsLocaleBidirectional(FLocale) then
  2933.       begin
  2934.         ScrollArea := Rect(ClientWidth - Horz.GridExtent, 0, ClientWidth - Horz.FixedBoundary, Vert.GridExtent);
  2935.         ScrollWindowEx(Handle, -DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2936.       end
  2937.       else
  2938. {$ENDIF}
  2939.       begin
  2940.         ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.GridExtent);
  2941.         ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2942.       end;
  2943.     end
  2944.     else if DX = 0 then
  2945.     begin
  2946.       { Scroll both the row titles and data area at the same time }
  2947.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.GridExtent, Vert.GridExtent);
  2948.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2949.     end
  2950.     else
  2951.     begin
  2952.       { Scroll titles and data area separately }
  2953.       { Column titles }
  2954.       ScrollArea := Rect(Horz.FixedBoundary, 0, Horz.GridExtent, Vert.FixedBoundary);
  2955.       ScrollWindowEx(Handle, DX, 0, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2956.       { Row titles }
  2957.       ScrollArea := Rect(0, Vert.FixedBoundary, Horz.FixedBoundary, Vert.GridExtent);
  2958.       ScrollWindowEx(Handle, 0, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2959.       { Data area }
  2960.       ScrollArea := Rect(Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridExtent,
  2961.         Vert.GridExtent);
  2962.       ScrollWindowEx(Handle, DX, DY, @ScrollArea, @ScrollArea, 0, nil, ScrollFlags);
  2963.     end;
  2964.   end;
  2965. end;
  2966.  
  2967. procedure TIvCustomGrid.ScrollData(DX, DY: Integer);
  2968. var
  2969.   DrawInfo: TIvGridDrawInfo;
  2970. begin
  2971.   CalcDrawInfo(DrawInfo);
  2972.   ScrollDataInfo(DX, DY, DrawInfo);
  2973. end;
  2974.  
  2975. procedure TIvCustomGrid.TopLeftMoved(const OldTopLeft: TIvGridCoord);
  2976.  
  2977.   function CalcScroll(const AxisInfo: TIvGridAxisDrawInfo;
  2978.     OldPos, CurrentPos: Integer; var Amount: Longint): Boolean;
  2979.   var
  2980.     Start, Stop: Longint;
  2981.     I: Longint;
  2982.   begin
  2983.     Result := False;
  2984.     with AxisInfo do
  2985.     begin
  2986.       if OldPos < CurrentPos then
  2987.       begin
  2988.         Start := OldPos;
  2989.         Stop := CurrentPos;
  2990.       end
  2991.       else
  2992.       begin
  2993.         Start := CurrentPos;
  2994.         Stop := OldPos;
  2995.       end;
  2996.       Amount := 0;
  2997.       for I := Start to Stop - 1 do
  2998.       begin
  2999.         Inc(Amount, GetExtent(I) + EffectiveLineWidth);
  3000.         if Amount > (GridBoundary - FixedBoundary) then
  3001.         begin
  3002.           { Scroll amount too big, redraw the whole thing }
  3003.           InvalidateGrid;
  3004.           Exit;
  3005.         end;
  3006.       end;
  3007.       if OldPos < CurrentPos then Amount := -Amount;
  3008.     end;
  3009.     Result := True;
  3010.   end;
  3011.  
  3012. var
  3013.   DrawInfo: TIvGridDrawInfo;
  3014.   Delta: TIvGridCoord;
  3015. begin
  3016.   UpdateScrollPos;
  3017.   CalcDrawInfo(DrawInfo);
  3018.   if CalcScroll(DrawInfo.Horz, OldTopLeft.X, FTopLeft.X, Delta.X) and
  3019.     CalcScroll(DrawInfo.Vert, OldTopLeft.Y, FTopLeft.Y, Delta.Y) then
  3020.     ScrollDataInfo(Delta.X, Delta.Y, DrawInfo);
  3021.   TopLeftChanged;
  3022. end;
  3023.  
  3024. procedure TIvCustomGrid.UpdateScrollPos;
  3025. var
  3026.   DrawInfo: TIvGridDrawInfo;
  3027.   MaxTopLeft: TIvGridCoord;
  3028.  
  3029.   procedure SetScroll(Code: Word; Value: Integer);
  3030.   begin
  3031.     if GetScrollPos(Handle, Code) <> Value then
  3032.       SetScrollPos(Handle, Code, Value, True);
  3033.   end;
  3034.  
  3035. var
  3036.   GridSpace, ColWidth: Integer;
  3037.  
  3038. begin
  3039.   if (not HandleAllocated) or (ScrollBars = ssNone) then Exit;
  3040.   CalcDrawInfo(DrawInfo);
  3041.   MaxTopLeft.X := ColCount - 1;
  3042.   MaxTopLeft.Y := RowCount - 1;
  3043.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  3044.   if ScrollBars in [ssHorizontal, ssBoth] then
  3045.     if ColCount = 1 then
  3046.     begin
  3047.       ColWidth := ColWidths[DrawInfo.Horz.FirstGridCell];
  3048.       GridSpace := ClientWidth - DrawInfo.Horz.FixedBoundary;
  3049.       if (FColOffset > 0) and (GridSpace > (ColWidth - FColOffset)) then
  3050.         ModifyScrollbar(SB_HORZ, SB_THUMBPOSITION, ColWidth - GridSpace)
  3051.       else
  3052.         SetScroll(SB_HORZ, FColOffset)
  3053.     end
  3054.     else
  3055.     begin
  3056. {$IFDEF IVPRO32}
  3057.       if IvIsLocaleBidirectional(FLocale) then
  3058.         SetScroll(
  3059.           SB_HORZ,
  3060.           IvMaxShortInt - LongMulDiv(FTopLeft.X - FixedCols, IvMaxShortInt, MaxTopLeft.X - FixedCols))
  3061.       else
  3062. {$ENDIF}
  3063.         SetScroll(
  3064.           SB_HORZ,
  3065.           LongMulDiv(FTopLeft.X - FixedCols, IvMaxShortInt, MaxTopLeft.X - FixedCols));
  3066.     end;
  3067.   if ScrollBars in [ssVertical, ssBoth] then
  3068.     SetScroll(SB_VERT, LongMulDiv(FTopLeft.Y - FixedRows, IvMaxShortInt,
  3069.       MaxTopLeft.Y - FixedRows));
  3070. end;
  3071.  
  3072. procedure TIvCustomGrid.UpdateScrollRange;
  3073. var
  3074.   MaxTopLeft, OldTopLeft: TIvGridCoord;
  3075.   DrawInfo: TIvGridDrawInfo;
  3076.   OldScrollBars: TScrollStyle;
  3077.   Updated: Boolean;
  3078.  
  3079.   procedure DoUpdate;
  3080.   begin
  3081.     if not Updated then
  3082.     begin
  3083.       Update;
  3084.       Updated := True;
  3085.     end;
  3086.   end;
  3087.  
  3088.   function ScrollBarVisible(Code: Word): Boolean;
  3089.   var
  3090.     Min, Max: Integer;
  3091.   begin
  3092.     Result := False;
  3093.     if (ScrollBars = ssBoth) or
  3094.       ((Code = SB_HORZ) and (ScrollBars = ssHorizontal)) or
  3095.       ((Code = SB_VERT) and (ScrollBars = ssVertical)) then
  3096.     begin
  3097.       GetScrollRange(Handle, Code, Min, Max);
  3098.       Result := Min <> Max;
  3099.     end;
  3100.   end;
  3101.  
  3102.   procedure CalcSizeInfo;
  3103.   begin
  3104.     CalcDrawInfoXY(DrawInfo, DrawInfo.Horz.GridExtent, DrawInfo.Vert.GridExtent);
  3105.     MaxTopLeft.X := ColCount - 1;
  3106.     MaxTopLeft.Y := RowCount - 1;
  3107.     MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  3108.   end;
  3109.  
  3110.   procedure SetAxisRange(var Max, Old, Current: Longint; Code: Word;
  3111.     Fixeds: Integer);
  3112.   begin
  3113.     CalcSizeInfo;
  3114.     if Fixeds < Max then
  3115.       SetScrollRange(Handle, Code, 0, IvMaxShortInt, True)
  3116.     else
  3117.       SetScrollRange(Handle, Code, 0, 0, True);
  3118.     if Old > Max then
  3119.     begin
  3120.       DoUpdate;
  3121.       Current := Max;
  3122.     end;
  3123.   end;
  3124.  
  3125.   procedure SetHorzRange;
  3126.   var
  3127.     Range: Integer;
  3128.   begin
  3129.     if OldScrollBars in [ssHorizontal, ssBoth] then
  3130.       if ColCount = 1 then
  3131.       begin
  3132.         Range := ColWidths[0] - ClientWidth;
  3133.         if Range < 0 then Range := 0;
  3134.         SetScrollRange(Handle, SB_HORZ, 0, Range, True);
  3135.       end
  3136.       else
  3137.         SetAxisRange(MaxTopLeft.X, OldTopLeft.X, FTopLeft.X, SB_HORZ, FixedCols);
  3138.   end;
  3139.  
  3140.   procedure SetVertRange;
  3141.   begin
  3142.     if OldScrollBars in [ssVertical, ssBoth] then
  3143.       SetAxisRange(MaxTopLeft.Y, OldTopLeft.Y, FTopLeft.Y, SB_VERT, FixedRows);
  3144.   end;
  3145.  
  3146. begin
  3147.   if (ScrollBars = ssNone) or not HandleAllocated then Exit;
  3148.   with DrawInfo do
  3149.   begin
  3150.     Horz.GridExtent := ClientWidth;
  3151.     Vert.GridExtent := ClientHeight;
  3152.     { Ignore scroll bars for initial calculation }
  3153.     if ScrollBarVisible(SB_HORZ) then
  3154.       Inc(Vert.GridExtent, GetSystemMetrics(SM_CYHSCROLL));
  3155.     if ScrollBarVisible(SB_VERT) then
  3156.       Inc(Horz.GridExtent, GetSystemMetrics(SM_CXVSCROLL));
  3157.   end;
  3158.   OldTopLeft := FTopLeft;
  3159.   { Temporarily mark us as not having scroll bars to avoid recursion }
  3160.   OldScrollBars := FScrollBars;
  3161.   FScrollBars := ssNone;
  3162.   Updated := False;
  3163.   try
  3164.     { Update scrollbars }
  3165.     SetHorzRange;
  3166.     DrawInfo.Vert.GridExtent := ClientHeight;
  3167.     SetVertRange;
  3168.     if DrawInfo.Horz.GridExtent <> ClientWidth then
  3169.     begin
  3170.       DrawInfo.Horz.GridExtent := ClientWidth;
  3171.       SetHorzRange;
  3172.     end;
  3173.   finally
  3174.     FScrollBars := OldScrollBars;
  3175.   end;
  3176.   UpdateScrollPos;
  3177.   if (FTopLeft.X <> OldTopLeft.X) or (FTopLeft.Y <> OldTopLeft.Y) then
  3178.     TopLeftMoved(OldTopLeft);
  3179. end;
  3180.  
  3181. function TIvCustomGrid.CreateEditor: TIvInplaceEdit;
  3182. begin
  3183.   Result := TIvInplaceEdit.Create(Self);
  3184. end;
  3185.  
  3186. procedure TIvCustomGrid.CreateParams(var Params: TCreateParams);
  3187. begin
  3188.   inherited CreateParams(Params);
  3189.   with Params do
  3190.   begin
  3191.     Style := Style or WS_TABSTOP;
  3192.     if FScrollBars in [ssVertical, ssBoth] then Style := Style or WS_VSCROLL;
  3193.     if FScrollBars in [ssHorizontal, ssBoth] then Style := Style or WS_HSCROLL;
  3194.     WindowClass.style := CS_DBLCLKS;
  3195.     if FBorderStyle = bsSingle then
  3196.       if NewStyleControls and Ctl3D then
  3197.       begin
  3198.         Style := Style and not WS_BORDER;
  3199.         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  3200.       end
  3201.       else
  3202.         Style := Style or WS_BORDER;
  3203.   end;
  3204. end;
  3205.  
  3206. procedure TIvCustomGrid.KeyDown(var Key: Word; Shift: TShiftState);
  3207. var
  3208.   NewTopLeft, NewCurrent, MaxTopLeft: TIvGridCoord;
  3209.   DrawInfo: TIvGridDrawInfo;
  3210.   PageWidth, PageHeight: Integer;
  3211.  
  3212.   procedure CalcPageExtents;
  3213.   begin
  3214.     CalcDrawInfo(DrawInfo);
  3215.     PageWidth := DrawInfo.Horz.LastFullVisibleCell - LeftCol;
  3216.     if PageWidth < 1 then PageWidth := 1;
  3217.     PageHeight := DrawInfo.Vert.LastFullVisibleCell - TopRow;
  3218.     if PageHeight < 1 then PageHeight := 1;
  3219.   end;
  3220.  
  3221.   procedure Restrict(var Coord: TIvGridCoord; MinX, MinY, MaxX, MaxY: Longint);
  3222.   begin
  3223.     with Coord do
  3224.     begin
  3225.       if X > MaxX then X := MaxX
  3226.       else if X < MinX then X := MinX;
  3227.       if Y > MaxY then Y := MaxY
  3228.       else if Y < MinY then Y := MinY;
  3229.     end;
  3230.   end;
  3231.  
  3232. begin
  3233.   inherited KeyDown(Key, Shift);
  3234.   if not CanGridAcceptKey(Key, Shift) then Key := 0;
  3235.   NewCurrent := FCurrent;
  3236.   NewTopLeft := FTopLeft;
  3237.   CalcPageExtents;
  3238.   if ssCtrl in Shift then
  3239.     case Key of
  3240.       VK_UP: Dec(NewTopLeft.Y);
  3241.       VK_DOWN: Inc(NewTopLeft.Y);
  3242.       VK_LEFT:
  3243.         if not (goRowSelect in Options) then
  3244.         begin
  3245.           Dec(NewCurrent.X, PageWidth);
  3246.           Dec(NewTopLeft.X, PageWidth);
  3247.         end;
  3248.       VK_RIGHT:
  3249.         if not (goRowSelect in Options) then
  3250.         begin
  3251.           Inc(NewCurrent.X, PageWidth);
  3252.           Inc(NewTopLeft.X, PageWidth);
  3253.         end;
  3254.       VK_PRIOR: NewCurrent.Y := TopRow;
  3255.       VK_NEXT: NewCurrent.Y := DrawInfo.Vert.LastFullVisibleCell;
  3256.       VK_HOME:
  3257.         begin
  3258.           NewCurrent.X := FixedCols;
  3259.           NewCurrent.Y := FixedRows;
  3260.         end;
  3261.       VK_END:
  3262.         begin
  3263.           NewCurrent.X := ColCount - 1;
  3264.           NewCurrent.Y := RowCount - 1;
  3265.         end;
  3266.     end
  3267.   else
  3268.     case Key of
  3269.       VK_UP: Dec(NewCurrent.Y);
  3270.       VK_DOWN: Inc(NewCurrent.Y);
  3271.       VK_LEFT:
  3272.         if goRowSelect in Options then
  3273.           Dec(NewCurrent.Y) else
  3274.           Dec(NewCurrent.X);
  3275.       VK_RIGHT:
  3276.         if goRowSelect in Options then
  3277.           Inc(NewCurrent.Y) else
  3278.           Inc(NewCurrent.X);
  3279.       VK_NEXT:
  3280.         begin
  3281.           Inc(NewCurrent.Y, PageHeight);
  3282.           Inc(NewTopLeft.Y, PageHeight);
  3283.         end;
  3284.       VK_PRIOR:
  3285.         begin
  3286.           Dec(NewCurrent.Y, PageHeight);
  3287.           Dec(NewTopLeft.Y, PageHeight);
  3288.         end;
  3289.       VK_HOME:
  3290.         if goRowSelect in Options then
  3291.           NewCurrent.Y := FixedRows else
  3292.           NewCurrent.X := FixedCols;
  3293.       VK_END:
  3294.         if goRowSelect in Options then
  3295.           NewCurrent.Y := RowCount - 1 else
  3296.           NewCurrent.X := ColCount - 1;
  3297.       VK_TAB:
  3298.         if not (ssAlt in Shift) then
  3299.         repeat
  3300.           if ssShift in Shift then
  3301.           begin
  3302.             Dec(NewCurrent.X);
  3303.             if NewCurrent.X < FixedCols then
  3304.             begin
  3305.               NewCurrent.X := ColCount - 1;
  3306.               Dec(NewCurrent.Y);
  3307.               if NewCurrent.Y < FixedRows then NewCurrent.Y := RowCount - 1;
  3308.             end;
  3309.             Shift := [];
  3310.           end
  3311.           else
  3312.           begin
  3313.             Inc(NewCurrent.X);
  3314.             if NewCurrent.X >= ColCount then
  3315.             begin
  3316.               NewCurrent.X := FixedCols;
  3317.               Inc(NewCurrent.Y);
  3318.               if NewCurrent.Y >= RowCount then NewCurrent.Y := FixedRows;
  3319.             end;
  3320.           end;
  3321.         until TabStops[NewCurrent.X] or (NewCurrent.X = FCurrent.X);
  3322.       VK_F2: EditorMode := True;
  3323.     end;
  3324.   MaxTopLeft.X := ColCount - 1;
  3325.   MaxTopLeft.Y := RowCount - 1;
  3326.   MaxTopLeft := CalcMaxTopLeft(MaxTopLeft, DrawInfo);
  3327.   Restrict(NewTopLeft, FixedCols, FixedRows, MaxTopLeft.X, MaxTopLeft.Y);
  3328.   if (NewTopLeft.X <> LeftCol) or (NewTopLeft.Y <> TopRow) then
  3329.     MoveTopLeft(NewTopLeft.X, NewTopLeft.Y);
  3330.   Restrict(NewCurrent, FixedCols, FixedRows, ColCount - 1, RowCount - 1);
  3331.   if (NewCurrent.X <> Col) or (NewCurrent.Y <> Row) then
  3332.     FocusCell(NewCurrent.X, NewCurrent.Y, not (ssShift in Shift));
  3333. end;
  3334.  
  3335. procedure TIvCustomGrid.KeyPress(var Key: Char);
  3336. begin
  3337.   inherited KeyPress(Key);
  3338.   if not (goAlwaysShowEditor in Options) and (Key = #13) then
  3339.   begin
  3340.     if FEditorMode then
  3341.       HideEditor else
  3342.       ShowEditor;
  3343.     Key := #0;
  3344.   end;
  3345. end;
  3346.  
  3347. procedure TIvCustomGrid.MouseDown(
  3348.   button: TMouseButton;
  3349.   shift: TShiftState;
  3350.   x, y: Integer);
  3351. var
  3352.   CellHit: TIvGridCoord;
  3353.   DrawInfo: TIvGridDrawInfo;
  3354.   MoveDrawn: Boolean;
  3355. begin
  3356.   MoveDrawn := False;
  3357.   HideEdit;
  3358.   if not (csDesigning in ComponentState) and
  3359.     (CanFocus or (GetParentForm(Self) = nil)) then
  3360.   begin
  3361.     SetFocus;
  3362.     if not IsActiveControl then
  3363.     begin
  3364.       MouseCapture := False;
  3365.       Exit;
  3366.     end;
  3367.   end;
  3368.   if (Button = mbLeft) and (ssDouble in Shift) then
  3369.     DblClick
  3370.   else if Button = mbLeft then
  3371.   begin
  3372.     CalcDrawInfo(DrawInfo);
  3373.     { Check grid sizing }
  3374.     CalcSizingState(X, Y, FGridState, FSizingIndex, FSizingPos, FSizingOfs,
  3375.       DrawInfo);
  3376.     if FGridState <> gsNormal then
  3377.     begin
  3378.       DrawSizingLine(DrawInfo);
  3379.       Exit;
  3380.     end;
  3381.     CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  3382.     if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) then
  3383.     begin
  3384.       if goEditing in Options then
  3385.       begin
  3386.         if (CellHit.X = FCurrent.X) and (CellHit.Y = FCurrent.Y) then
  3387.           ShowEditor
  3388.         else
  3389.         begin
  3390.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  3391.           UpdateEdit;
  3392.         end;
  3393.         Click;
  3394.       end
  3395.       else
  3396.       begin
  3397.         FGridState := gsSelecting;
  3398.         SetTimer(Handle, 1, 60, nil);
  3399.         if ssShift in Shift then
  3400.           MoveAnchor(CellHit)
  3401.         else
  3402.           MoveCurrent(CellHit.X, CellHit.Y, True, True);
  3403.       end;
  3404.     end
  3405.     else if (goRowMoving in Options) and (CellHit.X >= 0) and
  3406.       (CellHit.X < FixedCols) and (CellHit.Y >= FixedRows) then
  3407.     begin
  3408.       FGridState := gsRowMoving;
  3409.       FMoveIndex := CellHit.Y;
  3410.       FMovePos := FMoveIndex;
  3411.       Update;
  3412.       DrawMove;
  3413.       MoveDrawn := True;
  3414.       SetTimer(Handle, 1, 60, nil);
  3415.     end
  3416.     else if (goColMoving in Options) and (CellHit.Y >= 0) and
  3417.       (CellHit.Y < FixedRows) and (CellHit.X >= FixedCols) then
  3418.     begin
  3419.       FGridState := gsColMoving;
  3420.       FMoveIndex := CellHit.X;
  3421.       FMovePos := FMoveIndex;
  3422.       Update;
  3423.       DrawMove;
  3424.       MoveDrawn := True;
  3425.       SetTimer(Handle, 1, 60, nil);
  3426.     end;
  3427.   end;
  3428.   try
  3429.     inherited MouseDown(Button, Shift, X, Y);
  3430.   except
  3431.     if MoveDrawn then DrawMove;
  3432.   end;
  3433. end;
  3434.  
  3435. procedure TIvCustomGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
  3436. var
  3437.   DrawInfo: TIvGridDrawInfo;
  3438.   CellHit: TIvGridCoord;
  3439. begin
  3440.   CalcDrawInfo(DrawInfo);
  3441.   case FGridState of
  3442.     gsSelecting, gsColMoving, gsRowMoving:
  3443.       begin
  3444.         CellHit := CalcCoordFromPoint(X, Y, DrawInfo);
  3445.         if (CellHit.X >= FixedCols) and (CellHit.Y >= FixedRows) and
  3446.           (CellHit.X <= DrawInfo.Horz.LastFullVisibleCell+1) and
  3447.           (CellHit.Y <= DrawInfo.Vert.LastFullVisibleCell+1) then
  3448.           case FGridState of
  3449.             gsSelecting:
  3450.               if ((CellHit.X <> FAnchor.X) or (CellHit.Y <> FAnchor.Y)) then
  3451.                 MoveAnchor(CellHit);
  3452.             gsColMoving:
  3453.               MoveAndScroll(X, CellHit.X, DrawInfo, DrawInfo.Horz, SB_HORZ);
  3454.             gsRowMoving:
  3455.               MoveAndScroll(Y, CellHit.Y, DrawInfo, DrawInfo.Vert, SB_VERT);
  3456.           end;
  3457.       end;
  3458.     gsRowSizing, gsColSizing:
  3459.       begin
  3460.         DrawSizingLine(DrawInfo); { XOR it out }
  3461.         if FGridState = gsRowSizing then
  3462.           FSizingPos := Y + FSizingOfs else
  3463.           FSizingPos := X + FSizingOfs;
  3464.         DrawSizingLine(DrawInfo); { XOR it back in }
  3465.       end;
  3466.   end;
  3467.   inherited MouseMove(Shift, X, Y);
  3468. end;
  3469.  
  3470. procedure TIvCustomGrid.MouseUp(
  3471.   button: TMouseButton;
  3472.   shift: TShiftState;
  3473.   x, y: Integer);
  3474. var
  3475.   drawInfo: TIvGridDrawInfo;
  3476.   newSize: Integer;
  3477.  
  3478.   function ResizeLine(const axisInfo: TIvGridAxisDrawInfo): Integer;
  3479.   var
  3480.     i: Integer;
  3481.   begin
  3482.     Result := axisInfo.FixedBoundary;
  3483.     for i := axisInfo.FirstGridCell to FSizingIndex - 1 do
  3484.       Inc(Result, axisInfo.GetExtent(i) + axisInfo.EffectiveLineWidth);
  3485. {$IFDEF IVPRO32}
  3486.     if IvIsLocaleBidirectional(FLocale) and (axisInfo.AxisType = gaHorizontal) then
  3487.       Result := ClientWidth - FSizingPos - Result
  3488.     else
  3489. {$ENDIF}
  3490.       Result := FSizingPos - Result;
  3491.   end;
  3492.  
  3493. begin
  3494.   try
  3495.     case FGridState of
  3496.       gsSelecting:
  3497.         begin
  3498.           MouseMove(Shift, X, Y);
  3499.           KillTimer(Handle, 1);
  3500.           UpdateEdit;
  3501.           Click;
  3502.         end;
  3503.  
  3504.       gsRowSizing, gsColSizing:
  3505.         begin
  3506.           CalcDrawInfo(drawInfo);
  3507.           DrawSizingLine(drawInfo);
  3508.           if FGridState = gsColSizing then
  3509.           begin
  3510.             newSize := ResizeLine(drawInfo.Horz);
  3511.             if newSize > 1 then
  3512.             begin
  3513.               ColWidths[FSizingIndex] := newSize;
  3514.               UpdateDesigner;
  3515.             end;
  3516.           end
  3517.           else
  3518.           begin
  3519.             newSize := ResizeLine(drawInfo.Vert);
  3520.             if newSize > 1 then
  3521.             begin
  3522.               RowHeights[FSizingIndex] := newSize;
  3523.               UpdateDesigner;
  3524.             end;
  3525.           end;
  3526.         end;
  3527.  
  3528.       gsColMoving, gsRowMoving:
  3529.         begin
  3530.           DrawMove;
  3531.           KillTimer(Handle, 1);
  3532.           if FMoveIndex <> FMovePos then
  3533.           begin
  3534.             if FGridState = gsColMoving then
  3535.               MoveColumn(FMoveIndex, FMovePos)
  3536.             else
  3537.               MoveRow(FMoveIndex, FMovePos);
  3538.             UpdateDesigner;
  3539.           end;
  3540.           UpdateEdit;
  3541.         end;
  3542.     else
  3543.       UpdateEdit;
  3544.     end;
  3545.     inherited MouseUp(Button, Shift, X, Y);
  3546.   finally
  3547.     FGridState := gsNormal;
  3548.   end;
  3549. end;
  3550.  
  3551. procedure TIvCustomGrid.MoveAndScroll(Mouse, CellHit: Integer;
  3552.   var DrawInfo: TIvGridDrawInfo; var Axis: TIvGridAxisDrawInfo; ScrollBar: Integer);
  3553. begin
  3554.   if (CellHit <> FMovePos) and
  3555.     not((FMovePos = Axis.FixedCellCount) and (Mouse < Axis.FixedBoundary)) and
  3556.     not((FMovePos = Axis.GridCellCount-1) and (Mouse > Axis.GridBoundary)) then
  3557.   begin
  3558.     DrawMove;
  3559.     if (Mouse < Axis.FixedBoundary) then
  3560.     begin
  3561.       if (FMovePos > Axis.FixedCellCount) then
  3562.       begin
  3563.         ModifyScrollbar(ScrollBar, SB_LINEUP, 0);
  3564.         Update;
  3565.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3566.       end;
  3567.       CellHit := Axis.FirstGridCell;
  3568.     end
  3569.     else if (Mouse >= Axis.FullVisBoundary) then
  3570.     begin
  3571.       if (FMovePos = Axis.LastFullVisibleCell) and
  3572.         (FMovePos < Axis.GridCellCount -1) then
  3573.       begin
  3574.         ModifyScrollBar(Scrollbar, SB_LINEDOWN, 0);
  3575.         Update;
  3576.         CalcDrawInfo(DrawInfo);    // this changes contents of Axis var
  3577.       end;
  3578.       CellHit := Axis.LastFullVisibleCell;
  3579.     end
  3580.     else if CellHit < 0 then CellHit := FMovePos;
  3581.     FMovePos := CellHit;
  3582.     DrawMove;
  3583.   end;
  3584. end;
  3585.  
  3586. function TIvCustomGrid.GetColWidths(Index: Longint): Integer;
  3587. begin
  3588.   if (FColWidths = nil) or (Index >= ColCount) then
  3589.     Result := DefaultColWidth
  3590.   else
  3591.     Result := PIntArray(FColWidths)^[Index + 1];
  3592. end;
  3593.  
  3594. function TIvCustomGrid.GetRowHeights(Index: Longint): Integer;
  3595. begin
  3596.   if (FRowHeights = nil) or (Index >= RowCount) then
  3597.     Result := DefaultRowHeight
  3598.   else
  3599.     Result := PIntArray(FRowHeights)^[Index + 1];
  3600. end;
  3601.  
  3602. function TIvCustomGrid.GetGridWidth: Integer;
  3603. var
  3604.   DrawInfo: TIvGridDrawInfo;
  3605. begin
  3606.   CalcDrawInfo(DrawInfo);
  3607.   Result := DrawInfo.Horz.GridBoundary;
  3608. end;
  3609.  
  3610. function TIvCustomGrid.GetGridHeight: Integer;
  3611. var
  3612.   DrawInfo: TIvGridDrawInfo;
  3613. begin
  3614.   CalcDrawInfo(DrawInfo);
  3615.   Result := DrawInfo.Vert.GridBoundary;
  3616. end;
  3617.  
  3618. function TIvCustomGrid.GetSelection: TIvGridRect;
  3619. begin
  3620.   Result := GridRect(FCurrent, FAnchor);
  3621. end;
  3622.  
  3623. function TIvCustomGrid.GetTabStops(Index: Longint): Boolean;
  3624. begin
  3625.   if FTabStops = nil then Result := True
  3626.   else Result := Boolean(PIntArray(FTabStops)^[Index + 1]);
  3627. end;
  3628.  
  3629. function TIvCustomGrid.GetVisibleColCount: Integer;
  3630. var
  3631.   DrawInfo: TIvGridDrawInfo;
  3632. begin
  3633.   CalcDrawInfo(DrawInfo);
  3634.   Result := DrawInfo.Horz.LastFullVisibleCell - LeftCol + 1;
  3635. end;
  3636.  
  3637. function TIvCustomGrid.GetVisibleRowCount: Integer;
  3638. var
  3639.   DrawInfo: TIvGridDrawInfo;
  3640. begin
  3641.   CalcDrawInfo(DrawInfo);
  3642.   Result := DrawInfo.Vert.LastFullVisibleCell - TopRow + 1;
  3643. end;
  3644.  
  3645. procedure TIvCustomGrid.SetBorderStyle(Value: TBorderStyle);
  3646. begin
  3647.   if FBorderStyle <> Value then
  3648.   begin
  3649.     FBorderStyle := Value;
  3650.     RecreateWnd;
  3651.   end;
  3652. end;
  3653.  
  3654. procedure TIvCustomGrid.SetCol(Value: Longint);
  3655. begin
  3656.   if Col <> Value then FocusCell(Value, Row, True);
  3657. end;
  3658.  
  3659. procedure TIvCustomGrid.SetColCount(Value: Longint);
  3660. begin
  3661.   if FColCount <> Value then
  3662.   begin
  3663.     if Value < 1 then
  3664.       Value := 1;
  3665.     if Value <= FixedCols then
  3666.       FixedCols := Value - 1;
  3667.     ChangeSize(Value, RowCount);
  3668.     if goRowSelect in Options then
  3669.     begin
  3670.       FAnchor.X := ColCount - 1;
  3671.       Invalidate;
  3672.     end;
  3673.   end;
  3674. end;
  3675.  
  3676. procedure TIvCustomGrid.SetColWidths(Index: Longint; Value: Integer);
  3677. begin
  3678.   if FColWidths = nil then
  3679.     UpdateExtents(FColWidths, ColCount, DefaultColWidth);
  3680.  
  3681.   if Index >= ColCount then
  3682.     InvalidOp(SIndexOutOfRange);
  3683.  
  3684.   if Value <> PIntArray(FColWidths)^[Index + 1] then
  3685.   begin
  3686.     ResizeCol(Index, PIntArray(FColWidths)^[Index + 1], Value);
  3687.     PIntArray(FColWidths)^[Index + 1] := Value;
  3688.     ColWidthsChanged;
  3689.   end;
  3690. end;
  3691.  
  3692. procedure TIvCustomGrid.SetDefaultColWidth(Value: Integer);
  3693. begin
  3694.   if FColWidths <> nil then UpdateExtents(FColWidths, 0, 0);
  3695.   FDefaultColWidth := Value;
  3696.   ColWidthsChanged;
  3697.   InvalidateGrid;
  3698. end;
  3699.  
  3700. procedure TIvCustomGrid.SetDefaultRowHeight(Value: Integer);
  3701. begin
  3702.   if FRowHeights <> nil then UpdateExtents(FRowHeights, 0, 0);
  3703.   FDefaultRowHeight := Value;
  3704.   RowHeightsChanged;
  3705.   InvalidateGrid;
  3706. end;
  3707.  
  3708. procedure TIvCustomGrid.SetFixedColor(Value: TColor);
  3709. begin
  3710.   if FFixedColor <> Value then
  3711.   begin
  3712.     FFixedColor := Value;
  3713.     InvalidateGrid;
  3714.   end;
  3715. end;
  3716.  
  3717. procedure TIvCustomGrid.SetFixedCols(Value: Integer);
  3718. begin
  3719.   if FFixedCols <> Value then
  3720.   begin
  3721.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3722.     if Value >= ColCount then InvalidOp(SFixedColTooBig);
  3723.     FFixedCols := Value;
  3724.     Initialize;
  3725.     InvalidateGrid;
  3726.   end;
  3727. end;
  3728.  
  3729. procedure TIvCustomGrid.SetFixedRows(Value: Integer);
  3730. begin
  3731.   if FFixedRows <> Value then
  3732.   begin
  3733.     if Value < 0 then InvalidOp(SIndexOutOfRange);
  3734.     if Value >= RowCount then InvalidOp(SFixedRowTooBig);
  3735.     FFixedRows := Value;
  3736.     Initialize;
  3737.     InvalidateGrid;
  3738.   end;
  3739. end;
  3740.  
  3741. procedure TIvCustomGrid.SetEditorMode(Value: Boolean);
  3742. begin
  3743.   if not Value then
  3744.     HideEditor
  3745.   else
  3746.   begin
  3747.     ShowEditor;
  3748.     if FInplaceEdit <> nil then FInplaceEdit.Deselect;
  3749.   end;
  3750. end;
  3751.  
  3752. procedure TIvCustomGrid.SetGridLineWidth(Value: Integer);
  3753. begin
  3754.   if FGridLineWidth <> Value then
  3755.   begin
  3756.     FGridLineWidth := Value;
  3757.     InvalidateGrid;
  3758.   end;
  3759. end;
  3760.  
  3761. procedure TIvCustomGrid.SetLeftCol(Value: Longint);
  3762. begin
  3763.   if FTopLeft.X <> Value then MoveTopLeft(Value, TopRow);
  3764. end;
  3765.  
  3766. procedure TIvCustomGrid.SetOptions(Value: TIvGridOptions);
  3767. begin
  3768.   if FOptions <> Value then
  3769.   begin
  3770.     if goRowSelect in Value then
  3771.       Exclude(Value, goAlwaysShowEditor);
  3772.     FOptions := Value;
  3773.     if not FEditorMode then
  3774.       if goAlwaysShowEditor in Value then
  3775.         ShowEditor else
  3776.         HideEditor;
  3777.     if goRowSelect in Value then MoveCurrent(Col, Row,  True, False);
  3778.     InvalidateGrid;
  3779.   end;
  3780. end;
  3781.  
  3782. procedure TIvCustomGrid.SetRow(Value: Longint);
  3783. begin
  3784.   if Row <> Value then FocusCell(Col, Value, True);
  3785. end;
  3786.  
  3787. procedure TIvCustomGrid.SetRowCount(Value: Longint);
  3788. begin
  3789.   if FRowCount <> Value then
  3790.   begin
  3791.     if Value < 1 then Value := 1;
  3792.     if Value <= FixedRows then FixedRows := Value - 1;
  3793.     ChangeSize(ColCount, Value);
  3794.   end;
  3795. end;
  3796.  
  3797. procedure TIvCustomGrid.SetRowHeights(Index: Longint; Value: Integer);
  3798. begin
  3799.   if FRowHeights = nil then
  3800.     UpdateExtents(FRowHeights, RowCount, DefaultRowHeight);
  3801.   if Index >= RowCount then InvalidOp(SIndexOutOfRange);
  3802.   if Value <> PIntArray(FRowHeights)^[Index + 1] then
  3803.   begin
  3804.     ResizeRow(Index, PIntArray(FRowHeights)^[Index + 1], Value);
  3805.     PIntArray(FRowHeights)^[Index + 1] := Value;
  3806.     RowHeightsChanged;
  3807.   end;
  3808. end;
  3809.  
  3810. procedure TIvCustomGrid.SetScrollBars(Value: TScrollStyle);
  3811. begin
  3812.   if FScrollBars <> Value then
  3813.   begin
  3814.     FScrollBars := Value;
  3815.     RecreateWnd;
  3816.   end;
  3817. end;
  3818.  
  3819. procedure TIvCustomGrid.SetSelection(Value: TIvGridRect);
  3820. var
  3821.   OldSel: TIvGridRect;
  3822. begin
  3823.   OldSel := Selection;
  3824.   FAnchor := Value.TopLeft;
  3825.   FCurrent := Value.BottomRight;
  3826.   SelectionMoved(OldSel);
  3827. end;
  3828.  
  3829. procedure TIvCustomGrid.SetTabStops(Index: Longint; Value: Boolean);
  3830. begin
  3831.   if FTabStops = nil then
  3832.     UpdateExtents(FTabStops, ColCount, Integer(True));
  3833.   if Index >= ColCount then InvalidOp(SIndexOutOfRange);
  3834.   PIntArray(FTabStops)^[Index + 1] := Integer(Value);
  3835. end;
  3836.  
  3837. procedure TIvCustomGrid.SetTopRow(Value: Longint);
  3838. begin
  3839.   if FTopLeft.Y <> Value then MoveTopLeft(LeftCol, Value);
  3840. end;
  3841.  
  3842. procedure TIvCustomGrid.HideEdit;
  3843. begin
  3844.   if FInplaceEdit <> nil then
  3845.     try
  3846.       UpdateText;
  3847.     finally
  3848.       FInplaceCol := -1;
  3849.       FInplaceRow := -1;
  3850.       FInplaceEdit.Hide;
  3851.     end;
  3852. end;
  3853.  
  3854. procedure TIvCustomGrid.UpdateEdit;
  3855.  
  3856.   procedure UpdateEditor;
  3857.   begin
  3858.     FInplaceCol := Col;
  3859.     FInplaceRow := Row;
  3860.     FInplaceEdit.UpdateContents;
  3861.     if FInplaceEdit.MaxLength = -1 then
  3862.       FCanEditModify := False
  3863.     else
  3864.       FCanEditModify := True;
  3865.     FInplaceEdit.SelectAll;
  3866.   end;
  3867.  
  3868. begin
  3869.   if CanEditShow then
  3870.   begin
  3871.     if FInplaceEdit = nil then
  3872.     begin
  3873. {      FInplaceEdit := CreateEditor;
  3874.       FInplaceEdit.SetGrid(Self);
  3875.       FInplaceEdit.Parent := Self;
  3876.       UpdateEditor;}
  3877.     end
  3878.     else
  3879.     begin
  3880.       if (Col <> FInplaceCol) or (Row <> FInplaceRow) then
  3881.       begin
  3882.         HideEdit;
  3883.         UpdateEditor;
  3884.       end;
  3885.     end;
  3886.  
  3887.     FInplaceEdit.Free;
  3888.     FInplaceEdit := CreateEditor;
  3889.     FInplaceEdit.SetGrid(Self);
  3890.     FInplaceEdit.Parent := Self;
  3891.     UpdateEditor;
  3892.  
  3893.     FInplaceEdit.UpdateBidi(IvIsLocaleBidirectional(ColLocale[Col]));
  3894.  
  3895.     if CanEditShow then
  3896.       FInplaceEdit.Move(CellRect(Col, Row));
  3897.   end;
  3898. end;
  3899.  
  3900. procedure TIvCustomGrid.UpdateText;
  3901. begin
  3902.   if (FInplaceCol <> -1) and (FInplaceRow <> -1) then
  3903.     SetEditText(FInplaceCol, FInplaceRow, FInplaceEdit.Text);
  3904. end;
  3905.  
  3906. procedure TIvCustomGrid.WMChar(var Msg: TWMChar);
  3907. begin
  3908.   if (goEditing in Options) and (Char(Msg.CharCode) in [^H, #32..#255]) then
  3909.     ShowEditorChar(Char(Msg.CharCode))
  3910.   else
  3911.     inherited;
  3912. end;
  3913.  
  3914. procedure TIvCustomGrid.WMCommand(var Message: TWMCommand);
  3915. begin
  3916.   with Message do
  3917.   begin
  3918.     if (FInplaceEdit <> nil) and (Ctl = FInplaceEdit.Handle) then
  3919.       case NotifyCode of
  3920.         EN_CHANGE: UpdateText;
  3921.       end;
  3922.   end;
  3923. end;
  3924.  
  3925. procedure TIvCustomGrid.WMGetDlgCode(var Msg: TWMGetDlgCode);
  3926. begin
  3927.   Msg.Result := DLGC_WANTARROWS;
  3928.   if goRowSelect in Options then Exit;
  3929.   if goTabs in Options then Msg.Result := Msg.Result or DLGC_WANTTAB;
  3930.   if goEditing in Options then Msg.Result := Msg.Result or DLGC_WANTCHARS;
  3931. end;
  3932.  
  3933. procedure TIvCustomGrid.WMKillFocus(var Msg: TWMKillFocus);
  3934. begin
  3935.   inherited;
  3936.   InvalidateRect(Selection);
  3937.   if (FInplaceEdit <> nil) and (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3938.     HideEdit;
  3939. end;
  3940.  
  3941. procedure TIvCustomGrid.WMLButtonDown(var Message: TMessage);
  3942. begin
  3943.   inherited;
  3944.   if FInplaceEdit <> nil then FInplaceEdit.FClickTime := GetMessageTime;
  3945. end;
  3946.  
  3947. procedure TIvCustomGrid.WMNCHitTest(var Msg: TWMNCHitTest);
  3948. begin
  3949.   DefaultHandler(Msg);
  3950.   FHitTest := ScreenToClient(SmallPointToPoint(Msg.Pos));
  3951. end;
  3952.  
  3953. procedure TIvCustomGrid.WMSetCursor(var Msg: TWMSetCursor);
  3954. var
  3955.   DrawInfo: TIvGridDrawInfo;
  3956.   State: TIvGridState;
  3957.   Index: Longint;
  3958.   Pos, Ofs: Integer;
  3959.   Cur: HCURSOR;
  3960. begin
  3961.   Cur := 0;
  3962.   with Msg do
  3963.   begin
  3964.     if HitTest = HTCLIENT then
  3965.     begin
  3966.       if FGridState = gsNormal then
  3967.       begin
  3968.         CalcDrawInfo(DrawInfo);
  3969.         CalcSizingState(
  3970.           FHitTest.X,
  3971.           FHitTest.Y,
  3972.           State,
  3973.           Index,
  3974.           Pos,
  3975.           Ofs,
  3976.           DrawInfo);
  3977.       end
  3978.       else
  3979.         State := FGridState;
  3980.  
  3981.       if State = gsRowSizing then
  3982.         Cur := Screen.Cursors[crVSplit]
  3983.       else if State = gsColSizing then
  3984.         Cur := Screen.Cursors[crHSplit]
  3985.     end;
  3986.   end;
  3987.  
  3988.   if Cur <> 0 then
  3989.     SetCursor(Cur)
  3990.   else
  3991.     inherited;
  3992. end;
  3993.  
  3994. procedure TIvCustomGrid.WMSetFocus(var Msg: TWMSetFocus);
  3995. begin
  3996.   inherited;
  3997.   if (FInplaceEdit = nil) or (Msg.FocusedWnd <> FInplaceEdit.Handle) then
  3998.   begin
  3999.     InvalidateRect(Selection);
  4000.     UpdateEdit;
  4001.   end;
  4002. end;
  4003.  
  4004. procedure TIvCustomGrid.WMSize(var Msg: TWMSize);
  4005. begin
  4006.   inherited;
  4007.   UpdateScrollRange;
  4008. end;
  4009.  
  4010. procedure TIvCustomGrid.WMVScroll(var Msg: TWMVScroll);
  4011. begin
  4012.   ModifyScrollBar(SB_VERT, Msg.ScrollCode, Msg.Pos);
  4013. end;
  4014.  
  4015. procedure TIvCustomGrid.WMHScroll(var Msg: TWMHScroll);
  4016. begin
  4017.   ModifyScrollBar(SB_HORZ, Msg.ScrollCode, Msg.Pos);
  4018. end;
  4019.  
  4020. procedure TIvCustomGrid.CMCancelMode(var Msg: TMessage);
  4021. begin
  4022.   if Assigned(FInplaceEdit) then FInplaceEdit.WndProc(Msg);
  4023.   inherited;
  4024. end;
  4025.  
  4026. procedure TIvCustomGrid.CMFontChanged(var Message: TMessage);
  4027. begin
  4028.   if FInplaceEdit <> nil then FInplaceEdit.Font := Font;
  4029.   inherited;
  4030. end;
  4031.  
  4032. procedure TIvCustomGrid.CMCtl3DChanged(var Message: TMessage);
  4033. begin
  4034.   inherited;
  4035.   RecreateWnd;
  4036. end;
  4037.  
  4038. procedure TIvCustomGrid.CMDesignHitTest(var Msg: TCMDesignHitTest);
  4039. begin
  4040.   Msg.Result := Longint(BOOL(Sizing(Msg.Pos.X, Msg.Pos.Y)));
  4041. end;
  4042.  
  4043. procedure TIvCustomGrid.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
  4044. begin
  4045.   inherited;
  4046.   if (goEditing in Options) and (Char(Msg.CharCode) = #13) then Msg.Result := 1;
  4047. end;
  4048.  
  4049. procedure TIvCustomGrid.TimedScroll(Direction: TIvGridScrollDirection);
  4050. var
  4051.   MaxAnchor, NewAnchor: TIvGridCoord;
  4052. begin
  4053.   NewAnchor := FAnchor;
  4054.   MaxAnchor.X := ColCount - 1;
  4055.   MaxAnchor.Y := RowCount - 1;
  4056.   if (sdLeft in Direction) and (FAnchor.X > FixedCols) then Dec(NewAnchor.X);
  4057.   if (sdRight in Direction) and (FAnchor.X < MaxAnchor.X) then Inc(NewAnchor.X);
  4058.   if (sdUp in Direction) and (FAnchor.Y > FixedRows) then Dec(NewAnchor.Y);
  4059.   if (sdDown in Direction) and (FAnchor.Y < MaxAnchor.Y) then Inc(NewAnchor.Y);
  4060.   if (FAnchor.X <> NewAnchor.X) or (FAnchor.Y <> NewAnchor.Y) then
  4061.     MoveAnchor(NewAnchor);
  4062. end;
  4063.  
  4064. procedure TIvCustomGrid.WMTimer(var Msg: TWMTimer);
  4065. var
  4066.   Point: TPoint;
  4067.   DrawInfo: TIvGridDrawInfo;
  4068.   ScrollDirection: TIvGridScrollDirection;
  4069.   CellHit: TIvGridCoord;
  4070. begin
  4071.   if not (FGridState in [gsSelecting, gsRowMoving, gsColMoving]) then Exit;
  4072.   GetCursorPos(Point);
  4073.   Point := ScreenToClient(Point);
  4074.   CalcDrawInfo(DrawInfo);
  4075.   ScrollDirection := [];
  4076.   with DrawInfo do
  4077.   begin
  4078.     CellHit := CalcCoordFromPoint(Point.X, Point.Y, DrawInfo);
  4079.     case FGridState of
  4080.       gsColMoving:
  4081.         MoveAndScroll(Point.X, CellHit.X, DrawInfo, Horz, SB_HORZ);
  4082.       gsRowMoving:
  4083.         MoveAndScroll(Point.Y, CellHit.Y, DrawInfo, Vert, SB_VERT);
  4084.       gsSelecting:
  4085.       begin
  4086.         if Point.X < Horz.FixedBoundary then Include(ScrollDirection, sdLeft)
  4087.         else if Point.X > Horz.FullVisBoundary then Include(ScrollDirection, sdRight);
  4088.         if Point.Y < Vert.FixedBoundary then Include(ScrollDirection, sdUp)
  4089.         else if Point.Y > Vert.FullVisBoundary then Include(ScrollDirection, sdDown);
  4090.         if ScrollDirection <> [] then  TimedScroll(ScrollDirection);
  4091.       end;
  4092.     end;
  4093.   end;
  4094. end;
  4095.  
  4096. procedure TIvCustomGrid.ColWidthsChanged;
  4097. begin
  4098.   UpdateScrollRange;
  4099.   UpdateEdit;
  4100. end;
  4101.  
  4102. procedure TIvCustomGrid.RowHeightsChanged;
  4103. begin
  4104.   UpdateScrollRange;
  4105.   UpdateEdit;
  4106. end;
  4107.  
  4108. procedure TIvCustomGrid.DeleteColumn(ACol: Longint);
  4109. begin
  4110.   MoveColumn(ACol, ColCount-1);
  4111.   ColCount := ColCount - 1;
  4112. end;
  4113.  
  4114. procedure TIvCustomGrid.DeleteRow(ARow: Longint);
  4115. begin
  4116.   MoveRow(ARow, RowCount - 1);
  4117.   RowCount := RowCount - 1;
  4118. end;
  4119.  
  4120. procedure TIvCustomGrid.UpdateDesigner;
  4121. {$IFDEF IVWIDE}
  4122. var
  4123.   ParentForm: TCustomForm;
  4124. begin
  4125.   if (csDesigning in ComponentState) and HandleAllocated and
  4126.     not (csUpdating in ComponentState) then
  4127.   begin
  4128.     ParentForm := GetParentForm(Self);
  4129.     if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
  4130.       ParentForm.Designer.Modified;
  4131.   end;
  4132. end;
  4133. {$ELSE}
  4134. var
  4135.   ParentForm: TForm;
  4136. begin
  4137.   if (csDesigning in ComponentState) and HandleAllocated and
  4138.     not (csUpdating in ComponentState) then
  4139.   begin
  4140.     ParentForm := GetParentForm(Self);
  4141.     if Assigned(ParentForm) and Assigned(ParentForm.Designer) then
  4142.       ParentForm.Designer.Modified;
  4143.   end;
  4144. end;
  4145. {$ENDIF}
  4146.  
  4147.  
  4148. { TIvDrawGrid }
  4149.  
  4150. function TIvDrawGrid.CellRect(ACol, ARow: Longint): TRect;
  4151. begin
  4152.   Result := inherited CellRect(ACol, ARow);
  4153. end;
  4154.  
  4155. procedure TIvDrawGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
  4156. var
  4157.   Coord: TIvGridCoord;
  4158. begin
  4159.   Coord := MouseCoord(X, Y);
  4160.   ACol := Coord.X;
  4161.   ARow := Coord.Y;
  4162. end;
  4163.  
  4164. procedure TIvDrawGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  4165. begin
  4166.   if Assigned(FOnColumnMoved) then FOnColumnMoved(Self, FromIndex, ToIndex);
  4167. end;
  4168.  
  4169. function TIvDrawGrid.GetEditMask(ACol, ARow: Longint): string;
  4170. begin
  4171.   Result := '';
  4172.   if Assigned(FOnGetEditMask) then FOnGetEditMask(Self, ACol, ARow, Result);
  4173. end;
  4174.  
  4175. function TIvDrawGrid.GetEditText(ACol, ARow: Longint): string;
  4176. begin
  4177.   Result := '';
  4178.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  4179. end;
  4180.  
  4181. procedure TIvDrawGrid.RowMoved(FromIndex, ToIndex: Longint);
  4182. begin
  4183.   if Assigned(FOnRowMoved) then FOnRowMoved(Self, FromIndex, ToIndex);
  4184. end;
  4185.  
  4186. function TIvDrawGrid.SelectCell(ACol, ARow: Longint): Boolean;
  4187. begin
  4188.   Result := True;
  4189.   if Assigned(FOnSelectCell) then FOnSelectCell(Self, ACol, ARow, Result);
  4190. end;
  4191.  
  4192. procedure TIvDrawGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  4193. begin
  4194.   if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
  4195. end;
  4196.  
  4197. procedure TIvDrawGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  4198.   AState: TIvGridDrawState);
  4199. begin
  4200.   if Assigned(FOnDrawCell) then FOnDrawCell(Self, ACol, ARow, ARect, AState);
  4201. end;
  4202.  
  4203. procedure TIvDrawGrid.TopLeftChanged;
  4204. begin
  4205.   inherited TopLeftChanged;
  4206.   if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
  4207. end;
  4208.  
  4209. { StrItem management for TStringSparseList }
  4210.  
  4211. type
  4212.   PStrItem = ^TStrItem;
  4213.   TStrItem = record
  4214.     FObject: TObject;
  4215.     FString: string;
  4216.   end;
  4217.  
  4218. function NewStrItem(const AString: string; AObject: TObject): PStrItem;
  4219. begin
  4220.   New(Result);
  4221.   Result^.FObject := AObject;
  4222.   Result^.FString := AString;
  4223. end;
  4224.  
  4225. procedure DisposeStrItem(P: PStrItem);
  4226. begin
  4227.   Dispose(P);
  4228. end;
  4229.  
  4230. { Sparse array classes for TStringGrid }
  4231.  
  4232. type
  4233.  
  4234.   PPointer = ^Pointer;
  4235.  
  4236. { Exception classes }
  4237.  
  4238.   EStringSparseListError = class(Exception);
  4239.  
  4240. { TSparsePointerArray class}
  4241.  
  4242. { Used by TSparseList.  Based on Sparse1Array, but has Pointer elements
  4243.   and Integer index, just like TPointerList/TList, and less indirection }
  4244.  
  4245.   { Apply function for the applicator:
  4246.         TheIndex        Index of item in array
  4247.         TheItem         Value of item (i.e pointer element) in section
  4248.         Returns: 0 if success, else error code. }
  4249.   TSPAApply = function(TheIndex: Integer; TheItem: Pointer): Integer;
  4250.  
  4251.   TSecDir = array[0..4095] of Pointer;  { Enough for up to 12 bits of sec }
  4252.   PSecDir = ^TSecDir;
  4253.   TSPAQuantum = (SPASmall, SPALarge);   { Section size }
  4254.  
  4255.   TSparsePointerArray = class(TObject)
  4256.   private
  4257.     secDir: PSecDir;
  4258.     slotsInDir: Word;
  4259.     indexMask, secShift: Word;
  4260.     FHighBound: Integer;
  4261.     FSectionSize: Word;
  4262.     cachedIndex: Integer;
  4263.     cachedPointer: Pointer;
  4264.     { Return item[i], nil if slot outside defined section. }
  4265.     function  GetAt(Index: Integer): Pointer;
  4266.     { Return address of item[i], creating slot if necessary. }
  4267.     function  MakeAt(Index: Integer): PPointer;
  4268.     { Store item at item[i], creating slot if necessary. }
  4269.     procedure PutAt(Index: Integer; Item: Pointer);
  4270.   public
  4271.     constructor Create(Quantum: TSPAQuantum);
  4272.     destructor  Destroy; override;
  4273.  
  4274.     { Traverse SPA, calling apply function for each defined non-nil
  4275.       item.  The traversal terminates if the apply function returns
  4276.       a value other than 0. }
  4277.     { NOTE: must be static method so that we can take its address in
  4278.       TSparseList.ForAll }
  4279.     function  ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  4280.  
  4281.     { Ratchet down HighBound after a deletion }
  4282.     procedure ResetHighBound;
  4283.  
  4284.     property HighBound: Integer read FHighBound;
  4285.     property SectionSize: Word read FSectionSize;
  4286.     property Items[Index: Integer]: Pointer read GetAt write PutAt; default;
  4287.   end;
  4288.  
  4289. { TSparseList class }
  4290.  
  4291.   TSparseList = class(TObject)
  4292.   private
  4293.     FList: TSparsePointerArray;
  4294.     FCount: Integer;    { 1 + HighBound, adjusted for Insert/Delete }
  4295.     FQuantum: TSPAQuantum;
  4296.     procedure NewList(Quantum: TSPAQuantum);
  4297.   protected
  4298.     procedure Error; virtual;
  4299.     function  Get(Index: Integer): Pointer;
  4300.     procedure Put(Index: Integer; Item: Pointer);
  4301.   public
  4302.     constructor Create(Quantum: TSPAQuantum);
  4303.     destructor  Destroy; override;
  4304.     procedure Clear;
  4305.     procedure Delete(Index: Integer);
  4306.     procedure Exchange(Index1, Index2: Integer);
  4307.     function ForAll(ApplyFunction: Pointer {TSPAApply}): Integer;
  4308.     procedure Insert(Index: Integer; Item: Pointer);
  4309.     procedure Move(CurIndex, NewIndex: Integer);
  4310.     property Count: Integer read FCount;
  4311.     property Items[Index: Integer]: Pointer read Get write Put; default;
  4312.   end;
  4313.   PSparseList = ^TSparseList;
  4314.  
  4315. { TStringSparseList class }
  4316.  
  4317.   TStringSparseList = class(TStrings)
  4318.   private
  4319.     FList: TSparseList;                 { of StrItems }
  4320.     FOnChange: TNotifyEvent;
  4321.   protected
  4322.     function  Get(Index: Integer): String; override;
  4323.     function  GetCount: Integer; override;
  4324.     function  GetObject(Index: Integer): TObject; override;
  4325.     procedure Put(Index: Integer; const S: String); override;
  4326.     procedure PutObject(Index: Integer; AObject: TObject); override;
  4327.     procedure Changed; virtual;
  4328.     procedure Error; virtual;
  4329.   public
  4330.     constructor Create(Quantum: TSPAQuantum);
  4331.     destructor  Destroy; override;
  4332.     procedure ReadData(Reader: TReader);
  4333.     procedure WriteData(Writer: TWriter);
  4334.     procedure DefineProperties(Filer: TFiler); override;
  4335.     procedure Delete(Index: Integer); override;
  4336.     procedure Exchange(Index1, Index2: Integer); override;
  4337.     procedure Insert(Index: Integer; const S: String); override;
  4338.     procedure Clear; override;
  4339.     property List: TSparseList read FList;
  4340.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  4341.   end;
  4342.  
  4343. { TSparsePointerArray }
  4344.  
  4345. const
  4346.   SPAIndexMask: array[TSPAQuantum] of Byte = (15, 255);
  4347.   SPASecShift: array[TSPAQuantum] of Byte = (4, 8);
  4348.  
  4349. { Expand Section Directory to cover at least `newSlots' slots. Returns: Possibly
  4350.   updated pointer to the Section Directory. }
  4351. function  ExpandDir(secDir: PSecDir; var slotsInDir: Word;
  4352.   newSlots: Word): PSecDir;
  4353. begin
  4354.   Result := secDir;
  4355.   ReallocMem(Result, newSlots * SizeOf(Pointer));
  4356.   FillChar(Result^[slotsInDir], (newSlots - slotsInDir) * SizeOf(Pointer), 0);
  4357.   slotsInDir := newSlots;
  4358. end;
  4359.  
  4360. { Allocate a section and set all its items to nil. Returns: Pointer to start of
  4361.   section. }
  4362. function  MakeSec(SecIndex: Integer; SectionSize: Word): Pointer;
  4363. var
  4364.   SecP: Pointer;
  4365.   Size: Word;
  4366. begin
  4367.   Size := SectionSize * SizeOf(Pointer);
  4368.   GetMem(secP, size);
  4369.   FillChar(secP^, size, 0);
  4370.   MakeSec := SecP
  4371. end;
  4372.  
  4373. constructor TSparsePointerArray.Create(Quantum: TSPAQuantum);
  4374. begin
  4375.   SecDir := nil;
  4376.   SlotsInDir := 0;
  4377.   FHighBound := -1;
  4378.   FSectionSize := Word(SPAIndexMask[Quantum]) + 1;
  4379.   IndexMask := Word(SPAIndexMask[Quantum]);
  4380.   SecShift := Word(SPASecShift[Quantum]);
  4381.   CachedIndex := -1
  4382. end;
  4383.  
  4384. destructor TSparsePointerArray.Destroy;
  4385. var
  4386.   i:  Integer;
  4387.   size: Word;
  4388. begin
  4389.   { Scan section directory and free each section that exists. }
  4390.   i := 0;
  4391.   size := FSectionSize * SizeOf(Pointer);
  4392.   while i < slotsInDir do begin
  4393.     if secDir^[i] <> nil then
  4394.       FreeMem(secDir^[i], size);
  4395.     Inc(i)
  4396.   end;
  4397.  
  4398.   { Free section directory. }
  4399.   if secDir <> nil then
  4400.     FreeMem(secDir, slotsInDir * SizeOf(Pointer));
  4401. end;
  4402.  
  4403. function  TSparsePointerArray.GetAt(Index: Integer): Pointer;
  4404. var
  4405.   byteP: PChar;
  4406.   secIndex: Cardinal;
  4407. begin
  4408.   { Index into Section Directory using high order part of
  4409.     index.  Get pointer to Section. If not null, index into
  4410.     Section using low order part of index. }
  4411.   if Index = cachedIndex then
  4412.     Result := cachedPointer
  4413.   else begin
  4414.     secIndex := Index shr secShift;
  4415.     if secIndex >= slotsInDir then
  4416.       byteP := nil
  4417.     else begin
  4418.       byteP := secDir^[secIndex];
  4419.       if byteP <> nil then begin
  4420.         Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  4421.       end
  4422.     end;
  4423.     if byteP = nil then Result := nil else Result := PPointer(byteP)^;
  4424.     cachedIndex := Index;
  4425.     cachedPointer := Result
  4426.   end
  4427. end;
  4428.  
  4429. function  TSparsePointerArray.MakeAt(Index: Integer): PPointer;
  4430. var
  4431.   dirP: PSecDir;
  4432.   p: Pointer;
  4433.   byteP: PChar;
  4434.   secIndex: Word;
  4435. begin
  4436.   { Expand Section Directory if necessary. }
  4437.   secIndex := Index shr secShift;       { Unsigned shift }
  4438.   if secIndex >= slotsInDir then
  4439.     dirP := expandDir(secDir, slotsInDir, secIndex + 1)
  4440.   else
  4441.     dirP := secDir;
  4442.  
  4443.   { Index into Section Directory using high order part of
  4444.     index.  Get pointer to Section. If null, create new
  4445.     Section.  Index into Section using low order part of index. }
  4446.   secDir := dirP;
  4447.   p := dirP^[secIndex];
  4448.   if p = nil then begin
  4449.     p := makeSec(secIndex, FSectionSize);
  4450.     dirP^[secIndex] := p
  4451.   end;
  4452.   byteP := p;
  4453.   Inc(byteP, (Index and indexMask) * SizeOf(Pointer));
  4454.   if Index > FHighBound then
  4455.     FHighBound := Index;
  4456.   Result := PPointer(byteP);
  4457.   cachedIndex := -1
  4458. end;
  4459.  
  4460. procedure TSparsePointerArray.PutAt(Index: Integer; Item: Pointer);
  4461. begin
  4462.   if (Item <> nil) or (GetAt(Index) <> nil) then
  4463.   begin
  4464.     MakeAt(Index)^ := Item;
  4465.     if Item = nil then
  4466.       ResetHighBound
  4467.   end
  4468. end;
  4469.  
  4470. function  TSparsePointerArray.ForAll(ApplyFunction: Pointer {TSPAApply}):
  4471.   Integer;
  4472. var
  4473.   itemP: PChar;                         { Pointer to item in section }
  4474.   item: Pointer;
  4475.   i, callerBP: Cardinal;
  4476.   j, index: Integer;
  4477. begin
  4478.   { Scan section directory and scan each section that exists,
  4479.     calling the apply function for each non-nil item.
  4480.     The apply function must be a far local function in the scope of
  4481.     the procedure P calling ForAll.  The trick of setting up the stack
  4482.     frame (taken from TurboVision's TCollection.ForEach) allows the
  4483.     apply function access to P's arguments and local variables and,
  4484.     if P is a method, the instance variables and methods of P's class }
  4485.   Result := 0;
  4486.   i := 0;
  4487.   asm
  4488.     mov   eax,[ebp]                     { Set up stack frame for local }
  4489.     mov   callerBP,eax
  4490.   end;
  4491.   while (i < slotsInDir) and (Result = 0) do begin
  4492.     itemP := secDir^[i];
  4493.     if itemP <> nil then begin
  4494.       j := 0;
  4495.       index := i shl SecShift;
  4496.       while (j < FSectionSize) and (Result = 0) do begin
  4497.         item := PPointer(itemP)^;
  4498.         if item <> nil then
  4499.           { ret := ApplyFunction(index, item.Ptr); }
  4500.           asm
  4501.             mov   eax,index
  4502.             mov   edx,item
  4503.             push  callerBP
  4504.             call  ApplyFunction
  4505.             pop   ecx
  4506.             mov   @Result,eax
  4507.           end;
  4508.         Inc(itemP, SizeOf(Pointer));
  4509.         Inc(j);
  4510.         Inc(index)
  4511.       end
  4512.     end;
  4513.     Inc(i)
  4514.   end;
  4515. end;
  4516.  
  4517. procedure TSparsePointerArray.ResetHighBound;
  4518. var
  4519.   NewHighBound: Integer;
  4520.  
  4521.   function  Detector(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4522.   begin
  4523.     if TheIndex > FHighBound then
  4524.       Result := 1
  4525.     else
  4526.     begin
  4527.       Result := 0;
  4528.       if TheItem <> nil then NewHighBound := TheIndex
  4529.     end
  4530.   end;
  4531.  
  4532. begin
  4533.   NewHighBound := -1;
  4534.   ForAll(@Detector);
  4535.   FHighBound := NewHighBound
  4536. end;
  4537.  
  4538. { TSparseList }
  4539.  
  4540. constructor TSparseList.Create(Quantum: TSPAQuantum);
  4541. begin
  4542.   NewList(Quantum)
  4543. end;
  4544.  
  4545. destructor TSparseList.Destroy;
  4546. begin
  4547.   if FList <> nil then FList.Destroy
  4548. end;
  4549.  
  4550.  
  4551. procedure TSparseList.Clear;
  4552. begin
  4553.   FList.Destroy;
  4554.   NewList(FQuantum);
  4555.   FCount := 0
  4556. end;
  4557.  
  4558. procedure TSparseList.Delete(Index: Integer);
  4559. var
  4560.   I: Integer;
  4561. begin
  4562.   if (Index < 0) or (Index >= FCount) then Exit;
  4563.   for I := Index to FCount - 1 do
  4564.     FList[I] := FList[I + 1];
  4565.   FList[FCount] := nil;
  4566.   Dec(FCount);
  4567. end;
  4568.  
  4569. procedure TSparseList.Error;
  4570. begin
  4571. {$IFDEF IVWIDE}
  4572.   raise EListError.Create(SListIndexError);
  4573. {$ELSE}
  4574.   raise EListError.CreateRes(SListIndexError);
  4575. {$ENDIF}
  4576. end;
  4577.  
  4578. procedure TSparseList.Exchange(Index1, Index2: Integer);
  4579. var
  4580.   temp: Pointer;
  4581. begin
  4582.   temp := Get(Index1);
  4583.   Put(Index1, Get(Index2));
  4584.   Put(Index2, temp);
  4585. end;
  4586.  
  4587. { Jump to TSparsePointerArray.ForAll so that it looks like it was called
  4588.   from our caller, so that the BP trick works. }
  4589.  
  4590. function TSparseList.ForAll(ApplyFunction: Pointer {TSPAApply}): Integer; assembler;
  4591. asm
  4592.         MOV     EAX,[EAX].TSparseList.FList
  4593.         JMP     TSparsePointerArray.ForAll
  4594. end;
  4595.  
  4596. function  TSparseList.Get(Index: Integer): Pointer;
  4597. begin
  4598.   if Index < 0 then Error;
  4599.   Result := FList[Index]
  4600. end;
  4601.  
  4602. procedure TSparseList.Insert(Index: Integer; Item: Pointer);
  4603. var
  4604.   i: Integer;
  4605. begin
  4606.   if Index < 0 then Error;
  4607.   I := FCount;
  4608.   while I > Index do
  4609.   begin
  4610.     FList[i] := FList[i - 1];
  4611.     Dec(i)
  4612.   end;
  4613.   FList[Index] := Item;
  4614.   if Index > FCount then FCount := Index;
  4615.   Inc(FCount)
  4616. end;
  4617.  
  4618. procedure TSparseList.Move(CurIndex, NewIndex: Integer);
  4619. var
  4620.   Item: Pointer;
  4621. begin
  4622.   if CurIndex <> NewIndex then
  4623.   begin
  4624.     Item := Get(CurIndex);
  4625.     Delete(CurIndex);
  4626.     Insert(NewIndex, Item);
  4627.   end;
  4628. end;
  4629.  
  4630. procedure TSparseList.NewList(Quantum: TSPAQuantum);
  4631. begin
  4632.   FQuantum := Quantum;
  4633.   FList := TSparsePointerArray.Create(Quantum)
  4634. end;
  4635.  
  4636. procedure TSparseList.Put(Index: Integer; Item: Pointer);
  4637. begin
  4638.   if Index < 0 then Error;
  4639.   FList[Index] := Item;
  4640.   FCount := FList.HighBound + 1
  4641. end;
  4642.  
  4643. { TStringSparseList }
  4644.  
  4645. constructor TStringSparseList.Create(Quantum: TSPAQuantum);
  4646. begin
  4647.   FList := TSparseList.Create(Quantum)
  4648. end;
  4649.  
  4650. destructor  TStringSparseList.Destroy;
  4651. begin
  4652.   if FList <> nil then begin
  4653.     Clear;
  4654.     FList.Destroy
  4655.   end
  4656. end;
  4657.  
  4658. procedure TStringSparseList.ReadData(Reader: TReader);
  4659. var
  4660.   i: Integer;
  4661. begin
  4662.   with Reader do begin
  4663.     i := Integer(ReadInteger);
  4664.     while i > 0 do begin
  4665.       InsertObject(Integer(ReadInteger), ReadString, nil);
  4666.       Dec(i)
  4667.     end
  4668.   end
  4669. end;
  4670.  
  4671. procedure TStringSparseList.WriteData(Writer: TWriter);
  4672. var
  4673.   itemCount: Integer;
  4674.  
  4675.   function  CountItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4676.   begin
  4677.     Inc(itemCount);
  4678.     Result := 0
  4679.   end;
  4680.  
  4681.   function  StoreItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4682.   begin
  4683.     with Writer do
  4684.     begin
  4685.       WriteInteger(TheIndex);           { Item index }
  4686.       WriteString(PStrItem(TheItem)^.FString);
  4687.     end;
  4688.     Result := 0
  4689.   end;
  4690.  
  4691. begin
  4692.   with Writer do
  4693.   begin
  4694.     itemCount := 0;
  4695.     FList.ForAll(@CountItem);
  4696.     WriteInteger(itemCount);
  4697.     FList.ForAll(@StoreItem);
  4698.   end
  4699. end;
  4700.  
  4701. procedure TStringSparseList.DefineProperties(Filer: TFiler);
  4702. begin
  4703.   Filer.DefineProperty('List', ReadData, WriteData, True);
  4704. end;
  4705.  
  4706. function  TStringSparseList.Get(Index: Integer): String;
  4707. var
  4708.   p: PStrItem;
  4709. begin
  4710.   p := PStrItem(FList[Index]);
  4711.   if p = nil then Result := '' else Result := p^.FString
  4712. end;
  4713.  
  4714. function  TStringSparseList.GetCount: Integer;
  4715. begin
  4716.   Result := FList.Count
  4717. end;
  4718.  
  4719. function  TStringSparseList.GetObject(Index: Integer): TObject;
  4720. var
  4721.   p: PStrItem;
  4722. begin
  4723.   p := PStrItem(FList[Index]);
  4724.   if p = nil then Result := nil else Result := p^.FObject
  4725. end;
  4726.  
  4727. procedure TStringSparseList.Put(Index: Integer; const S: String);
  4728. var
  4729.   p: PStrItem;
  4730.   obj: TObject;
  4731. begin
  4732.   p := PStrItem(FList[Index]);
  4733.   if p = nil then obj := nil else obj := p^.FObject;
  4734.   if (S = '') and (obj = nil) then   { Nothing left to store }
  4735.     FList[Index] := nil
  4736.   else
  4737.     FList[Index] := NewStrItem(S, obj);
  4738.   if p <> nil then DisposeStrItem(p);
  4739.   Changed
  4740. end;
  4741.  
  4742. procedure TStringSparseList.PutObject(Index: Integer; AObject: TObject);
  4743. var
  4744.   p: PStrItem;
  4745. begin
  4746.   p := PStrItem(FList[Index]);
  4747.   if p <> nil then
  4748.     p^.FObject := AObject
  4749.   else if AObject <> nil then
  4750.     FList[Index] := NewStrItem('',AObject);
  4751.   Changed
  4752. end;
  4753.  
  4754. procedure TStringSparseList.Changed;
  4755. begin
  4756.   if Assigned(FOnChange) then FOnChange(Self)
  4757. end;
  4758.  
  4759. procedure TStringSparseList.Error;
  4760. begin
  4761. {$IFDEF IVWIDE}
  4762.   raise EStringSparseListError.Create(SPutObjectError);
  4763. {$ELSE}
  4764.   raise EStringSparseListError.CreateRes(SPutObjectError);
  4765. {$ENDIF}
  4766. end;
  4767.  
  4768. procedure TStringSparseList.Delete(Index: Integer);
  4769. var
  4770.   p: PStrItem;
  4771. begin
  4772.   p := PStrItem(FList[Index]);
  4773.   if p <> nil then DisposeStrItem(p);
  4774.   FList.Delete(Index);
  4775.   Changed
  4776. end;
  4777.  
  4778. procedure TStringSparseList.Exchange(Index1, Index2: Integer);
  4779. begin
  4780.   FList.Exchange(Index1, Index2);
  4781. end;
  4782.  
  4783. procedure TStringSparseList.Insert(Index: Integer; const S: String);
  4784. begin
  4785.   FList.Insert(Index, NewStrItem(S, nil));
  4786.   Changed
  4787. end;
  4788.  
  4789. procedure TStringSparseList.Clear;
  4790.  
  4791.   function  ClearItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4792.   begin
  4793.     DisposeStrItem(PStrItem(TheItem));    { Item guaranteed non-nil }
  4794.     Result := 0
  4795.   end;
  4796.  
  4797. begin
  4798.   FList.ForAll(@ClearItem);
  4799.   FList.Clear;
  4800.   Changed
  4801. end;
  4802.  
  4803. { TIvStringGridStrings }
  4804.  
  4805. constructor TIvStringGridStrings.Create(AGrid: TIvStringGrid; AIndex: Longint);
  4806. begin
  4807.   inherited Create;
  4808.   FGrid := AGrid;
  4809.   FIndex := AIndex;
  4810. end;
  4811.  
  4812. procedure TIvStringGridStrings.Assign(Source: TPersistent);
  4813. var
  4814.   I, Max: Integer;
  4815. begin
  4816.   if Source is TStrings then
  4817.   begin
  4818.     BeginUpdate;
  4819.     Max := TStrings(Source).Count - 1;
  4820.     if Max >= Count then Max := Count - 1;
  4821.     try
  4822.       for I := 0 to Max do
  4823.       begin
  4824.         Put(I, TStrings(Source).Strings[I]);
  4825.         PutObject(I, TStrings(Source).Objects[I]);
  4826.       end;
  4827.     finally
  4828.       EndUpdate;
  4829.     end;
  4830.     Exit;
  4831.   end;
  4832.   inherited Assign(Source);
  4833. end;
  4834.  
  4835. procedure TIvStringGridStrings.CalcXY(Index: Integer; var X, Y: Integer);
  4836. begin
  4837.   if FIndex = 0 then
  4838.   begin
  4839.     X := -1; Y := -1;
  4840.   end else if FIndex > 0 then
  4841.   begin
  4842.     X := Index;
  4843.     Y := FIndex - 1;
  4844.   end else
  4845.   begin
  4846.     X := -FIndex - 1;
  4847.     Y := Index;
  4848.   end;
  4849. end;
  4850.  
  4851. { Changes the meaning of Add to mean copy to the first empty string }
  4852. function TIvStringGridStrings.Add(const S: string): Integer;
  4853. var
  4854.   I: Integer;
  4855. begin
  4856.   for I := 0 to Count - 1 do
  4857.     if Strings[I] = '' then
  4858.     begin
  4859.       Strings[I] := S;
  4860.       Result := I;
  4861.       Exit;
  4862.     end;
  4863.   Result := -1;
  4864. end;
  4865.  
  4866. procedure TIvStringGridStrings.Clear;
  4867. var
  4868.   SSList: TStringSparseList;
  4869.   I: Integer;
  4870.  
  4871.   function BlankStr(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4872.   begin
  4873.     Objects[TheIndex] := nil;
  4874.     Strings[TheIndex] := '';
  4875.     Result := 0;
  4876.   end;
  4877.  
  4878. begin
  4879.   if FIndex > 0 then
  4880.   begin
  4881.     SSList := TStringSparseList(TSparseList(FGrid.FData)[FIndex - 1]);
  4882.     if SSList <> nil then SSList.List.ForAll(@BlankStr);
  4883.   end
  4884.   else if FIndex < 0 then
  4885.     for I := Count - 1 downto 0 do
  4886.     begin
  4887.       Objects[I] := nil;
  4888.       Strings[I] := '';
  4889.     end;
  4890. end;
  4891.  
  4892. {$IFDEF IVWIDE}
  4893. procedure TIvStringGridStrings.Delete(Index: Integer);
  4894. begin
  4895.   InvalidOp(sInvalidStringGridOp);
  4896. end;
  4897.  
  4898. procedure TIvStringGridStrings.Insert(Index: Integer; const S: string);
  4899. begin
  4900.   InvalidOp(sInvalidStringGridOp);
  4901. end;
  4902. {$ENDIF}
  4903.  
  4904. function TIvStringGridStrings.Get(Index: Integer): string;
  4905. var
  4906.   X, Y: Integer;
  4907. begin
  4908.   CalcXY(Index, X, Y);
  4909.   if X < 0 then Result := '' else Result := FGrid.Cells[X, Y];
  4910. end;
  4911.  
  4912. function TIvStringGridStrings.GetCount: Integer;
  4913. begin
  4914.   { Count of a row is the column count, and vice versa }
  4915.   if FIndex = 0 then Result := 0
  4916.   else if FIndex > 0 then Result := Integer(FGrid.ColCount)
  4917.   else Result := Integer(FGrid.RowCount);
  4918. end;
  4919.  
  4920. function TIvStringGridStrings.GetObject(Index: Integer): TObject;
  4921. var
  4922.   X, Y: Integer;
  4923. begin
  4924.   CalcXY(Index, X, Y);
  4925.   if X < 0 then Result := nil else Result := FGrid.Objects[X, Y];
  4926. end;
  4927.  
  4928. procedure TIvStringGridStrings.Put(Index: Integer; const S: string);
  4929. var
  4930.   X, Y: Integer;
  4931. begin
  4932.   CalcXY(Index, X, Y);
  4933.   FGrid.Cells[X, Y] := S;
  4934. end;
  4935.  
  4936. procedure TIvStringGridStrings.PutObject(Index: Integer; AObject: TObject);
  4937. var
  4938.   X, Y: Integer;
  4939. begin
  4940.   CalcXY(Index, X, Y);
  4941.   FGrid.Objects[X, Y] := AObject;
  4942. end;
  4943.  
  4944. procedure TIvStringGridStrings.SetUpdateState(Updating: Boolean);
  4945. begin
  4946.   FGrid.SetUpdateState(Updating);
  4947. end;
  4948.  
  4949. { TIvStringGrid }
  4950.  
  4951. constructor TIvStringGrid.Create(AOwner: TComponent);
  4952. begin
  4953.   inherited Create(AOwner);
  4954.   Initialize;
  4955. end;
  4956.  
  4957. destructor TIvStringGrid.Destroy;
  4958.  
  4959.   function FreeItem(TheIndex: Integer; TheItem: Pointer): Integer; far;
  4960.   begin
  4961.     TObject(TheItem).Free;
  4962.     Result := 0;
  4963.   end;
  4964.  
  4965. begin
  4966.   if FRows <> nil then
  4967.   begin
  4968.     TSparseList(FRows).ForAll(@FreeItem);
  4969.     TSparseList(FRows).Free;
  4970.   end;
  4971.  
  4972.   if FCols <> nil then
  4973.   begin
  4974.     TSparseList(FCols).ForAll(@FreeItem);
  4975.     TSparseList(FCols).Free;
  4976.   end;
  4977.  
  4978.   if FData <> nil then
  4979.   begin
  4980.     TSparseList(FData).ForAll(@FreeItem);
  4981.     TSparseList(FData).Free;
  4982.   end;
  4983.  
  4984.   inherited Destroy;
  4985. end;
  4986.  
  4987. procedure TIvStringGrid.ColumnMoved(FromIndex, ToIndex: Longint);
  4988.  
  4989.   function MoveColData(Index: Integer; ARow: TStringSparseList): Integer; far;
  4990.   begin
  4991.     ARow.Move(FromIndex, ToIndex);
  4992.     Result := 0;
  4993.   end;
  4994.  
  4995. begin
  4996.   TSparseList(FData).ForAll(@MoveColData);
  4997.   Invalidate;
  4998.   inherited ColumnMoved(FromIndex, ToIndex);
  4999. end;
  5000.  
  5001. procedure TIvStringGrid.RowMoved(FromIndex, ToIndex: Longint);
  5002. begin
  5003.   TSparseList(FData).Move(FromIndex, ToIndex);
  5004.   Invalidate;
  5005.   inherited RowMoved(FromIndex, ToIndex);
  5006. end;
  5007.  
  5008. function TIvStringGrid.GetEditText(ACol, ARow: Longint): string;
  5009. begin
  5010.   Result := Cells[ACol, ARow];
  5011.   if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
  5012. end;
  5013.  
  5014. procedure TIvStringGrid.SetEditText(ACol, ARow: Longint; const Value: string);
  5015. begin
  5016.   DisableEditUpdate;
  5017.   try
  5018.     if Value <> Cells[ACol, ARow] then Cells[ACol, ARow] := Value;
  5019.   finally
  5020.     EnableEditUpdate;
  5021.   end;
  5022.   inherited SetEditText(ACol, ARow, Value);
  5023. end;
  5024.  
  5025. procedure TIvStringGrid.DrawCell(
  5026.   ACol, ARow: Longint;
  5027.   ARect: TRect;
  5028.   AState: TIvGridDrawState);
  5029. var
  5030.   str: String;
  5031.   flags: Integer;
  5032. begin
  5033.   if DefaultDrawing then
  5034.   begin
  5035.     str := Cells[ACol, ARow];
  5036. {$IFDEF IVPRO32}
  5037.     if IvIsLocaleBidirectional(ColLocale[ACol]) then
  5038.     begin
  5039.       InflateRect(ARect, -3, -2);
  5040.       flags := DT_RIGHT or DT_RTLREADING;
  5041.     end
  5042.     else
  5043. {$ENDIF}
  5044.     begin
  5045.       InflateRect(ARect, -2, -2);
  5046.       flags := DT_LEFT;
  5047.     end;
  5048.     DrawTextEx(
  5049.       Canvas.Handle,
  5050.       PChar(str),
  5051.       Length(str),
  5052.       ARect,
  5053.       flags,
  5054.       nil);
  5055.   end;
  5056.   inherited DrawCell(ACol, ARow, ARect, AState);
  5057. end;
  5058.  
  5059. procedure TIvStringGrid.DisableEditUpdate;
  5060. begin
  5061.   Inc(FEditUpdate);
  5062. end;
  5063.  
  5064. procedure TIvStringGrid.EnableEditUpdate;
  5065. begin
  5066.   Dec(FEditUpdate);
  5067. end;
  5068.  
  5069. procedure TIvStringGrid.Initialize;
  5070. var
  5071.   quantum: TSPAQuantum;
  5072. begin
  5073.   if FCols = nil then
  5074.   begin
  5075.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  5076.     FCols := TSparseList.Create(quantum);
  5077.   end;
  5078.   if RowCount > 256 then quantum := SPALarge else quantum := SPASmall;
  5079.   if FRows = nil then FRows := TSparseList.Create(quantum);
  5080.   if FData = nil then FData := TSparseList.Create(quantum);
  5081. end;
  5082.  
  5083. procedure TIvStringGrid.SetUpdateState(Updating: Boolean);
  5084. begin
  5085.   FUpdating := Updating;
  5086.   if not Updating and FNeedsUpdating then
  5087.   begin
  5088.     InvalidateGrid;
  5089.     FNeedsUpdating := False;
  5090.   end;
  5091. end;
  5092.  
  5093. procedure TIvStringGrid.UpdateCell(ACol, ARow: Integer);
  5094. begin
  5095.   if not FUpdating then InvalidateCell(ACol, ARow)
  5096.   else FNeedsUpdating := True;
  5097.   if (ACol = Col) and (ARow = Row) and (FEditUpdate = 0) then InvalidateEditor;
  5098. end;
  5099.  
  5100. function  TIvStringGrid.EnsureColRow(Index: Integer; IsCol: Boolean):
  5101.   TIvStringGridStrings;
  5102. var
  5103.   RCIndex: Integer;
  5104.   PList: PSparseList;
  5105. begin
  5106.   if IsCol then
  5107.     PList := PSparseList(@FCols)
  5108.   else
  5109.     PList := PSparseList(@FRows);
  5110.   Result := TIvStringGridStrings(PList^[Index]);
  5111.   if Result = nil then
  5112.   begin
  5113.     if IsCol then RCIndex := -Index - 1 else RCIndex := Index + 1;
  5114.     Result := TIvStringGridStrings.Create(Self, RCIndex);
  5115.     PList^[Index] := Result;
  5116.   end;
  5117. end;
  5118.  
  5119. function  TIvStringGrid.EnsureDataRow(ARow: Integer): Pointer;
  5120. var
  5121.   quantum: TSPAQuantum;
  5122. begin
  5123.   Result := TStringSparseList(TSparseList(FData)[ARow]);
  5124.   if Result = nil then
  5125.   begin
  5126.     if ColCount > 512 then quantum := SPALarge else quantum := SPASmall;
  5127.     Result := TStringSparseList.Create(quantum);
  5128.     TSparseList(FData)[ARow] := Result;
  5129.   end;
  5130. end;
  5131.  
  5132. function TIvStringGrid.GetCells(ACol, ARow: Integer): string;
  5133. var
  5134.   ssl: TStringSparseList;
  5135. begin
  5136.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  5137.   if ssl = nil then Result := '' else Result := ssl[ACol];
  5138. end;
  5139.  
  5140. function TIvStringGrid.GetCols(Index: Integer): TStrings;
  5141. begin
  5142.   Result := EnsureColRow(Index, True);
  5143. end;
  5144.  
  5145. function TIvStringGrid.GetObjects(ACol, ARow: Integer): TObject;
  5146. var
  5147.   ssl: TStringSparseList;
  5148. begin
  5149.   ssl := TStringSparseList(TSparseList(FData)[ARow]);
  5150.   if ssl = nil then Result := nil else Result := ssl.Objects[ACol];
  5151. end;
  5152.  
  5153. function TIvStringGrid.GetRows(Index: Integer): TStrings;
  5154. begin
  5155.   Result := EnsureColRow(Index, False);
  5156. end;
  5157.  
  5158. procedure TIvStringGrid.SetCells(ACol, ARow: Integer; const Value: string);
  5159. begin
  5160.   TIvStringGridStrings(EnsureDataRow(ARow))[ACol] := Value;
  5161.   EnsureColRow(ACol, True);
  5162.   EnsureColRow(ARow, False);
  5163.   UpdateCell(ACol, ARow);
  5164. end;
  5165.  
  5166. procedure TIvStringGrid.SetCols(Index: Integer; Value: TStrings);
  5167. begin
  5168.   EnsureColRow(Index, True).Assign(Value);
  5169. end;
  5170.  
  5171. procedure TIvStringGrid.SetObjects(ACol, ARow: Integer; Value: TObject);
  5172. begin
  5173.   TIvStringGridStrings(EnsureDataRow(ARow)).Objects[ACol] := Value;
  5174.   EnsureColRow(ACol, True);
  5175.   EnsureColRow(ARow, False);
  5176.   UpdateCell(ACol, ARow);
  5177. end;
  5178.  
  5179. procedure TIvStringGrid.SetRows(Index: Integer; Value: TStrings);
  5180. begin
  5181.   EnsureColRow(Index, False).Assign(Value);
  5182. end;
  5183. {$ENDIF}
  5184.  
  5185. end.
  5186.  
  5187.  
  5188.